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   warn "use $namespace"; #if $DEBUG #erroring out??
4388   eval "use $namespace";
4389   die $@ if $@;
4390
4391   ###
4392   # check for banned credit card/ACH
4393   ###
4394
4395   my $ban = qsearchs('banned_pay', {
4396     'payby'   => $bop_method2payby{$options{method}},
4397     'payinfo' => md5_base64($options{payinfo}),
4398   } );
4399   return "Banned credit card" if $ban;
4400
4401   ###
4402   # massage data
4403   ###
4404
4405   my $bop_content = $self->_bop_content(\%options);
4406   return $bop_content unless ref($bop_content);
4407
4408   my @invoicing_list = $self->invoicing_list_emailonly;
4409   if ( $conf->exists('emailinvoiceautoalways')
4410        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4411        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4412     push @invoicing_list, $self->all_emails;
4413   }
4414
4415   my $email = ($conf->exists('business-onlinepayment-email-override'))
4416               ? $conf->config('business-onlinepayment-email-override')
4417               : $invoicing_list[0];
4418
4419   my $paydate = '';
4420   my %content = ();
4421   if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
4422
4423     $content{card_number} = $options{payinfo};
4424     $paydate = exists($options{'paydate'})
4425                     ? $options{'paydate'}
4426                     : $self->paydate;
4427     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4428     $content{expiration} = "$2/$1";
4429
4430     my $paycvv = exists($options{'paycvv'})
4431                    ? $options{'paycvv'}
4432                    : $self->paycvv;
4433     $content{cvv2} = $paycvv
4434       if length($paycvv);
4435
4436     my $paystart_month = exists($options{'paystart_month'})
4437                            ? $options{'paystart_month'}
4438                            : $self->paystart_month;
4439
4440     my $paystart_year  = exists($options{'paystart_year'})
4441                            ? $options{'paystart_year'}
4442                            : $self->paystart_year;
4443
4444     $content{card_start} = "$paystart_month/$paystart_year"
4445       if $paystart_month && $paystart_year;
4446
4447     my $payissue       = exists($options{'payissue'})
4448                            ? $options{'payissue'}
4449                            : $self->payissue;
4450     $content{issue_number} = $payissue if $payissue;
4451
4452     if ( $self->_bop_recurring_billing( 'payinfo'        => $options{'payinfo'},
4453                                         'trans_is_recur' => $trans_is_recur,
4454                                       )
4455        )
4456     {
4457       $content{recurring_billing} = 'YES';
4458       $content{acct_code} = 'rebill'
4459         if $conf->exists('credit_card-recurring_billing_acct_code');
4460     }
4461
4462   } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
4463     ( $content{account_number}, $content{routing_code} ) =
4464       split('@', $options{payinfo});
4465     $content{bank_name} = $options{payname};
4466     $content{bank_state} = exists($options{'paystate'})
4467                              ? $options{'paystate'}
4468                              : $self->getfield('paystate');
4469     $content{account_type} = exists($options{'paytype'})
4470                                ? uc($options{'paytype'}) || 'CHECKING'
4471                                : uc($self->getfield('paytype')) || 'CHECKING';
4472     $content{account_name} = $self->getfield('first'). ' '.
4473                              $self->getfield('last');
4474
4475     $content{customer_org} = $self->company ? 'B' : 'I';
4476     $content{state_id}       = exists($options{'stateid'})
4477                                  ? $options{'stateid'}
4478                                  : $self->getfield('stateid');
4479     $content{state_id_state} = exists($options{'stateid_state'})
4480                                  ? $options{'stateid_state'}
4481                                  : $self->getfield('stateid_state');
4482     $content{customer_ssn} = exists($options{'ss'})
4483                                ? $options{'ss'}
4484                                : $self->ss;
4485   } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
4486     $content{phone} = $options{payinfo};
4487   } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4488     #move along
4489   } else {
4490     #die an evil death
4491   }
4492
4493   ###
4494   # run transaction(s)
4495   ###
4496
4497   my $balance = exists( $options{'balance'} )
4498                   ? $options{'balance'}
4499                   : $self->balance;
4500
4501   $self->select_for_update; #mutex ... just until we get our pending record in
4502
4503   #the checks here are intended to catch concurrent payments
4504   #double-form-submission prevention is taken care of in cust_pay_pending::check
4505
4506   #check the balance
4507   return "The customer's balance has changed; $options{method} transaction aborted."
4508     if $self->balance < $balance;
4509     #&& $self->balance < $options{amount}; #might as well anyway?
4510
4511   #also check and make sure there aren't *other* pending payments for this cust
4512
4513   my @pending = qsearch('cust_pay_pending', {
4514     'custnum' => $self->custnum,
4515     'status'  => { op=>'!=', value=>'done' }
4516   });
4517   return "A payment is already being processed for this customer (".
4518          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4519          "); $options{method} transaction aborted."
4520     if scalar(@pending);
4521
4522   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4523
4524   my $cust_pay_pending = new FS::cust_pay_pending {
4525     'custnum'           => $self->custnum,
4526     #'invnum'            => $options{'invnum'},
4527     'paid'              => $options{amount},
4528     '_date'             => '',
4529     'payby'             => $bop_method2payby{$options{method}},
4530     'payinfo'           => $options{payinfo},
4531     'paydate'           => $paydate,
4532     'recurring_billing' => $content{recurring_billing},
4533     'pkgnum'            => $options{'pkgnum'},
4534     'status'            => 'new',
4535     'gatewaynum'        => $payment_gateway->gatewaynum || '',
4536     'session_id'        => $options{session_id} || '',
4537     'jobnum'            => $options{depend_jobnum} || '',
4538   };
4539   $cust_pay_pending->payunique( $options{payunique} )
4540     if defined($options{payunique}) && length($options{payunique});
4541   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4542   return $cpp_new_err if $cpp_new_err;
4543
4544   my( $action1, $action2 ) =
4545     split( /\s*\,\s*/, $payment_gateway->gateway_action );
4546
4547   my $transaction = new $namespace( $payment_gateway->gateway_module,
4548                                     $self->_bop_options(\%options),
4549                                   );
4550
4551   $transaction->content(
4552     'type'           => $options{method},
4553     $self->_bop_auth(\%options),
4554     'action'         => $action1,
4555     'description'    => $options{'description'},
4556     'amount'         => $options{amount},
4557     #'invoice_number' => $options{'invnum'},
4558     'customer_id'    => $self->custnum,
4559     %$bop_content,
4560     'reference'      => $cust_pay_pending->paypendingnum, #for now
4561     'email'          => $email,
4562     %content, #after
4563   );
4564
4565   $cust_pay_pending->status('pending');
4566   my $cpp_pending_err = $cust_pay_pending->replace;
4567   return $cpp_pending_err if $cpp_pending_err;
4568
4569   #config?
4570   my $BOP_TESTING = 0;
4571   my $BOP_TESTING_SUCCESS = 1;
4572
4573   unless ( $BOP_TESTING ) {
4574     $transaction->test_transaction(1)
4575       if $conf->exists('business-onlinepayment-test_transaction');
4576     $transaction->submit();
4577   } else {
4578     if ( $BOP_TESTING_SUCCESS ) {
4579       $transaction->is_success(1);
4580       $transaction->authorization('fake auth');
4581     } else {
4582       $transaction->is_success(0);
4583       $transaction->error_message('fake failure');
4584     }
4585   }
4586
4587   if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4588
4589     return { reference => $cust_pay_pending->paypendingnum,
4590              map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
4591
4592   } elsif ( $transaction->is_success() && $action2 ) {
4593
4594     $cust_pay_pending->status('authorized');
4595     my $cpp_authorized_err = $cust_pay_pending->replace;
4596     return $cpp_authorized_err if $cpp_authorized_err;
4597
4598     my $auth = $transaction->authorization;
4599     my $ordernum = $transaction->can('order_number')
4600                    ? $transaction->order_number
4601                    : '';
4602
4603     my $capture =
4604       new Business::OnlinePayment( $payment_gateway->gateway_module,
4605                                    $self->_bop_options(\%options),
4606                                  );
4607
4608     my %capture = (
4609       %content,
4610       type           => $options{method},
4611       action         => $action2,
4612       $self->_bop_auth(\%options),
4613       order_number   => $ordernum,
4614       amount         => $options{amount},
4615       authorization  => $auth,
4616       description    => $options{'description'},
4617     );
4618
4619     foreach my $field (qw( authorization_source_code returned_ACI
4620                            transaction_identifier validation_code
4621                            transaction_sequence_num local_transaction_date
4622                            local_transaction_time AVS_result_code          )) {
4623       $capture{$field} = $transaction->$field() if $transaction->can($field);
4624     }
4625
4626     $capture->content( %capture );
4627
4628     $capture->test_transaction(1)
4629       if $conf->exists('business-onlinepayment-test_transaction');
4630     $capture->submit();
4631
4632     unless ( $capture->is_success ) {
4633       my $e = "Authorization successful but capture failed, custnum #".
4634               $self->custnum. ': '.  $capture->result_code.
4635               ": ". $capture->error_message;
4636       warn $e;
4637       return $e;
4638     }
4639
4640   }
4641
4642   ###
4643   # remove paycvv after initial transaction
4644   ###
4645
4646   #false laziness w/misc/process/payment.cgi - check both to make sure working
4647   # correctly
4648   if ( defined $self->dbdef_table->column('paycvv')
4649        && length($self->paycvv)
4650        && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
4651   ) {
4652     my $error = $self->remove_cvv;
4653     if ( $error ) {
4654       warn "WARNING: error removing cvv: $error\n";
4655     }
4656   }
4657
4658   ###
4659   # Tokenize
4660   ###
4661
4662
4663   if ( $transaction->can('card_token') && $transaction->card_token ) {
4664
4665     $self->card_token($transaction->card_token);
4666
4667     if ( $options{'payinfo'} eq $self->payinfo ) {
4668       $self->payinfo($transaction->card_token);
4669       my $error = $self->replace;
4670       if ( $error ) {
4671         warn "WARNING: error storing token: $error, but proceeding anyway\n";
4672       }
4673     }
4674
4675   }
4676
4677   ###
4678   # result handling
4679   ###
4680
4681   $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
4682
4683 }
4684
4685 =item fake_bop
4686
4687 =cut
4688
4689 sub fake_bop {
4690   my $self = shift;
4691
4692   my %options = ();
4693   if (ref($_[0]) eq 'HASH') {
4694     %options = %{$_[0]};
4695   } else {
4696     my ( $method, $amount ) = ( shift, shift );
4697     %options = @_;
4698     $options{method} = $method;
4699     $options{amount} = $amount;
4700   }
4701
4702   if ( $options{'fake_failure'} ) {
4703      return "Error: No error; test failure requested with fake_failure";
4704   }
4705
4706   #my $paybatch = '';
4707   #if ( $payment_gateway->gatewaynum ) { # agent override
4708   #  $paybatch = $payment_gateway->gatewaynum. '-';
4709   #}
4710   #
4711   #$paybatch .= "$processor:". $transaction->authorization;
4712   #
4713   #$paybatch .= ':'. $transaction->order_number
4714   #  if $transaction->can('order_number')
4715   #  && length($transaction->order_number);
4716
4717   my $paybatch = 'FakeProcessor:54:32';
4718
4719   my $cust_pay = new FS::cust_pay ( {
4720      'custnum'  => $self->custnum,
4721      'invnum'   => $options{'invnum'},
4722      'paid'     => $options{amount},
4723      '_date'    => '',
4724      'payby'    => $bop_method2payby{$options{method}},
4725      #'payinfo'  => $payinfo,
4726      'payinfo'  => '4111111111111111',
4727      'paybatch' => $paybatch,
4728      #'paydate'  => $paydate,
4729      'paydate'  => '2012-05-01',
4730   } );
4731   $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
4732
4733   my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4734
4735   if ( $error ) {
4736     $cust_pay->invnum(''); #try again with no specific invnum
4737     my $error2 = $cust_pay->insert( $options{'manual'} ?
4738                                     ( 'manual' => 1 ) : ()
4739                                   );
4740     if ( $error2 ) {
4741       # gah, even with transactions.
4742       my $e = 'WARNING: Card/ACH debited but database not updated - '.
4743               "error inserting (fake!) payment: $error2".
4744               " (previously tried insert with invnum #$options{'invnum'}" .
4745               ": $error )";
4746       warn $e;
4747       return $e;
4748     }
4749   }
4750
4751   if ( $options{'paynum_ref'} ) {
4752     ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4753   }
4754
4755   return ''; #no error
4756
4757 }
4758
4759
4760 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
4761 #
4762 # Wraps up processing of a realtime credit card, ACH (electronic check) or
4763 # phone bill transaction.
4764
4765 sub _realtime_bop_result {
4766   my( $self, $cust_pay_pending, $transaction, %options ) = @_;
4767   if ( $DEBUG ) {
4768     warn "$me _realtime_bop_result: pending transaction ".
4769       $cust_pay_pending->paypendingnum. "\n";
4770     warn "  $_ => $options{$_}\n" foreach keys %options;
4771   }
4772
4773   my $payment_gateway = $options{payment_gateway}
4774     or return "no payment gateway in arguments to _realtime_bop_result";
4775
4776   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
4777   my $cpp_captured_err = $cust_pay_pending->replace;
4778   return $cpp_captured_err if $cpp_captured_err;
4779
4780   if ( $transaction->is_success() ) {
4781
4782     my $paybatch = '';
4783     if ( $payment_gateway->gatewaynum ) { # agent override
4784       $paybatch = $payment_gateway->gatewaynum. '-';
4785     }
4786
4787     $paybatch .= $payment_gateway->gateway_module. ":".
4788       $transaction->authorization;
4789
4790     $paybatch .= ':'. $transaction->order_number
4791       if $transaction->can('order_number')
4792       && length($transaction->order_number);
4793
4794     my $cust_pay = new FS::cust_pay ( {
4795        'custnum'  => $self->custnum,
4796        'invnum'   => $options{'invnum'},
4797        'paid'     => $cust_pay_pending->paid,
4798        '_date'    => '',
4799        'payby'    => $cust_pay_pending->payby,
4800        #'payinfo'  => $payinfo,
4801        'paybatch' => $paybatch,
4802        'paydate'  => $cust_pay_pending->paydate,
4803        'pkgnum'   => $cust_pay_pending->pkgnum,
4804     } );
4805     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
4806     $cust_pay->payunique( $options{payunique} )
4807       if defined($options{payunique}) && length($options{payunique});
4808
4809     my $oldAutoCommit = $FS::UID::AutoCommit;
4810     local $FS::UID::AutoCommit = 0;
4811     my $dbh = dbh;
4812
4813     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
4814
4815     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
4816
4817     if ( $error ) {
4818       $cust_pay->invnum(''); #try again with no specific invnum
4819       my $error2 = $cust_pay->insert( $options{'manual'} ?
4820                                       ( 'manual' => 1 ) : ()
4821                                     );
4822       if ( $error2 ) {
4823         # gah.  but at least we have a record of the state we had to abort in
4824         # from cust_pay_pending now.
4825         my $e = "WARNING: $options{method} captured but payment not recorded -".
4826                 " error inserting payment (". $payment_gateway->gateway_module.
4827                 "): $error2".
4828                 " (previously tried insert with invnum #$options{'invnum'}" .
4829                 ": $error ) - pending payment saved as paypendingnum ".
4830                 $cust_pay_pending->paypendingnum. "\n";
4831         warn $e;
4832         return $e;
4833       }
4834     }
4835
4836     my $jobnum = $cust_pay_pending->jobnum;
4837     if ( $jobnum ) {
4838        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
4839
4840        unless ( $placeholder ) {
4841          $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4842          my $e = "WARNING: $options{method} captured but job $jobnum not ".
4843              "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
4844          warn $e;
4845          return $e;
4846        }
4847
4848        $error = $placeholder->delete;
4849
4850        if ( $error ) {
4851          $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4852          my $e = "WARNING: $options{method} captured but could not delete ".
4853               "job $jobnum for paypendingnum ".
4854               $cust_pay_pending->paypendingnum. ": $error\n";
4855          warn $e;
4856          return $e;
4857        }
4858
4859     }
4860
4861     if ( $options{'paynum_ref'} ) {
4862       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
4863     }
4864
4865     $cust_pay_pending->status('done');
4866     $cust_pay_pending->statustext('captured');
4867     $cust_pay_pending->paynum($cust_pay->paynum);
4868     my $cpp_done_err = $cust_pay_pending->replace;
4869
4870     if ( $cpp_done_err ) {
4871
4872       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4873       my $e = "WARNING: $options{method} captured but payment not recorded - ".
4874               "error updating status for paypendingnum ".
4875               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4876       warn $e;
4877       return $e;
4878
4879     } else {
4880
4881       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4882
4883       if ( $options{'apply'} ) {
4884         my $apply_error = $self->apply_payments_and_credits;
4885         if ( $apply_error ) {
4886           warn "WARNING: error applying payment: $apply_error\n";
4887           #but we still should return no error cause the payment otherwise went
4888           #through...
4889         }
4890       }
4891
4892       return ''; #no error
4893
4894     }
4895
4896   } else {
4897
4898     my $perror = $payment_gateway->gateway_module. " error: ".
4899       $transaction->error_message;
4900
4901     my $jobnum = $cust_pay_pending->jobnum;
4902     if ( $jobnum ) {
4903        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
4904
4905        if ( $placeholder ) {
4906          my $error = $placeholder->depended_delete;
4907          $error ||= $placeholder->delete;
4908          warn "error removing provisioning jobs after declined paypendingnum ".
4909            $cust_pay_pending->paypendingnum. "\n";
4910        } else {
4911          my $e = "error finding job $jobnum for declined paypendingnum ".
4912               $cust_pay_pending->paypendingnum. "\n";
4913          warn $e;
4914        }
4915
4916     }
4917
4918     unless ( $transaction->error_message ) {
4919
4920       my $t_response;
4921       if ( $transaction->can('response_page') ) {
4922         $t_response = {
4923                         'page'    => ( $transaction->can('response_page')
4924                                          ? $transaction->response_page
4925                                          : ''
4926                                      ),
4927                         'code'    => ( $transaction->can('response_code')
4928                                          ? $transaction->response_code
4929                                          : ''
4930                                      ),
4931                         'headers' => ( $transaction->can('response_headers')
4932                                          ? $transaction->response_headers
4933                                          : ''
4934                                      ),
4935                       };
4936       } else {
4937         $t_response .=
4938           "No additional debugging information available for ".
4939             $payment_gateway->gateway_module;
4940       }
4941
4942       $perror .= "No error_message returned from ".
4943                    $payment_gateway->gateway_module. " -- ".
4944                  ( ref($t_response) ? Dumper($t_response) : $t_response );
4945
4946     }
4947
4948     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
4949          && $conf->exists('emaildecline')
4950          && grep { $_ ne 'POST' } $self->invoicing_list
4951          && ! grep { $transaction->error_message =~ /$_/ }
4952                    $conf->config('emaildecline-exclude')
4953     ) {
4954       my @templ = $conf->config('declinetemplate');
4955       my $template = new Text::Template (
4956         TYPE   => 'ARRAY',
4957         SOURCE => [ map "$_\n", @templ ],
4958       ) or return "($perror) can't create template: $Text::Template::ERROR";
4959       $template->compile()
4960         or return "($perror) can't compile template: $Text::Template::ERROR";
4961
4962       my $templ_hash = {
4963         'company_name'    =>
4964           scalar( $conf->config('company_name', $self->agentnum ) ),
4965         'company_address' =>
4966           join("\n", $conf->config('company_address', $self->agentnum ) ),
4967         'error'           => $transaction->error_message,
4968       };
4969
4970       my $error = send_email(
4971         'from'    => $conf->config('invoice_from', $self->agentnum ),
4972         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
4973         'subject' => 'Your payment could not be processed',
4974         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
4975       );
4976
4977       $perror .= " (also received error sending decline notification: $error)"
4978         if $error;
4979
4980     }
4981
4982     $cust_pay_pending->status('done');
4983     $cust_pay_pending->statustext("declined: $perror");
4984     my $cpp_done_err = $cust_pay_pending->replace;
4985     if ( $cpp_done_err ) {
4986       my $e = "WARNING: $options{method} declined but pending payment not ".
4987               "resolved - error updating status for paypendingnum ".
4988               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
4989       warn $e;
4990       $perror = "$e ($perror)";
4991     }
4992
4993     return $perror;
4994   }
4995
4996 }
4997
4998 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
4999
5000 Verifies successful third party processing of a realtime credit card,
5001 ACH (electronic check) or phone bill transaction via a
5002 Business::OnlineThirdPartyPayment realtime gateway.  See
5003 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5004
5005 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5006
5007 The additional options I<payname>, I<city>, I<state>,
5008 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
5009 if set, will override the value from the customer record.
5010
5011 I<description> is a free-text field passed to the gateway.  It defaults to
5012 "Internet services".
5013
5014 If an I<invnum> is specified, this payment (if successful) is applied to the
5015 specified invoice.  If you don't specify an I<invnum> you might want to
5016 call the B<apply_payments> method.
5017
5018 I<quiet> can be set true to surpress email decline notices.
5019
5020 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
5021 resulting paynum, if any.
5022
5023 I<payunique> is a unique identifier for this payment.
5024
5025 Returns a hashref containing elements bill_error (which will be undefined
5026 upon success) and session_id of any associated session.
5027
5028 =cut
5029
5030 sub realtime_botpp_capture {
5031   my( $self, $cust_pay_pending, %options ) = @_;
5032   if ( $DEBUG ) {
5033     warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5034     warn "  $_ => $options{$_}\n" foreach keys %options;
5035   }
5036
5037   eval "use Business::OnlineThirdPartyPayment";
5038   die $@ if $@;
5039
5040   ###
5041   # select the gateway
5042   ###
5043
5044   my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5045
5046   my $payment_gateway = $cust_pay_pending->gatewaynum
5047     ? qsearchs( 'payment_gateway',
5048                 { gatewaynum => $cust_pay_pending->gatewaynum }
5049               )
5050     : $self->agent->payment_gateway( 'method' => $method,
5051                                      # 'invnum'  => $cust_pay_pending->invnum,
5052                                      # 'payinfo' => $cust_pay_pending->payinfo,
5053                                    );
5054
5055   $options{payment_gateway} = $payment_gateway; # for the helper subs
5056
5057   ###
5058   # massage data
5059   ###
5060
5061   my @invoicing_list = $self->invoicing_list_emailonly;
5062   if ( $conf->exists('emailinvoiceautoalways')
5063        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5064        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5065     push @invoicing_list, $self->all_emails;
5066   }
5067
5068   my $email = ($conf->exists('business-onlinepayment-email-override'))
5069               ? $conf->config('business-onlinepayment-email-override')
5070               : $invoicing_list[0];
5071
5072   my %content = ();
5073
5074   $content{email_customer} =
5075     (    $conf->exists('business-onlinepayment-email_customer')
5076       || $conf->exists('business-onlinepayment-email-override') );
5077
5078   ###
5079   # run transaction(s)
5080   ###
5081
5082   my $transaction =
5083     new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5084                                            $self->_bop_options(\%options),
5085                                          );
5086
5087   $transaction->reference({ %options });
5088
5089   $transaction->content(
5090     'type'           => $method,
5091     $self->_bop_auth(\%options),
5092     'action'         => 'Post Authorization',
5093     'description'    => $options{'description'},
5094     'amount'         => $cust_pay_pending->paid,
5095     #'invoice_number' => $options{'invnum'},
5096     'customer_id'    => $self->custnum,
5097     'referer'        => 'http://cleanwhisker.420.am/',
5098     'reference'      => $cust_pay_pending->paypendingnum,
5099     'email'          => $email,
5100     'phone'          => $self->daytime || $self->night,
5101     %content, #after
5102     # plus whatever is required for bogus capture avoidance
5103   );
5104
5105   $transaction->submit();
5106
5107   my $error =
5108     $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5109
5110   {
5111     bill_error => $error,
5112     session_id => $cust_pay_pending->session_id,
5113   }
5114
5115 }
5116
5117 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5118
5119 =cut
5120
5121 sub default_payment_gateway {
5122   my( $self, $method ) = @_;
5123
5124   die "Real-time processing not enabled\n"
5125     unless $conf->exists('business-onlinepayment');
5126
5127   #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5128
5129   #load up config
5130   my $bop_config = 'business-onlinepayment';
5131   $bop_config .= '-ach'
5132     if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5133   my ( $processor, $login, $password, $action, @bop_options ) =
5134     $conf->config($bop_config);
5135   $action ||= 'normal authorization';
5136   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5137   die "No real-time processor is enabled - ".
5138       "did you set the business-onlinepayment configuration value?\n"
5139     unless $processor;
5140
5141   ( $processor, $login, $password, $action, @bop_options )
5142 }
5143
5144 =item remove_cvv
5145
5146 Removes the I<paycvv> field from the database directly.
5147
5148 If there is an error, returns the error, otherwise returns false.
5149
5150 =cut
5151
5152 sub remove_cvv {
5153   my $self = shift;
5154   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5155     or return dbh->errstr;
5156   $sth->execute($self->custnum)
5157     or return $sth->errstr;
5158   $self->paycvv('');
5159   '';
5160 }
5161
5162 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5163
5164 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5165 via a Business::OnlinePayment realtime gateway.  See
5166 L<http://420.am/business-onlinepayment> for supported gateways.
5167
5168 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5169
5170 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5171
5172 Most gateways require a reference to an original payment transaction to refund,
5173 so you probably need to specify a I<paynum>.
5174
5175 I<amount> defaults to the original amount of the payment if not specified.
5176
5177 I<reason> specifies a reason for the refund.
5178
5179 I<paydate> specifies the expiration date for a credit card overriding the
5180 value from the customer record or the payment record. Specified as yyyy-mm-dd
5181
5182 Implementation note: If I<amount> is unspecified or equal to the amount of the
5183 orignal payment, first an attempt is made to "void" the transaction via
5184 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5185 the normal attempt is made to "refund" ("credit") the transaction via the
5186 gateway is attempted.
5187
5188 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5189 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
5190 #if set, will override the value from the customer record.
5191
5192 #If an I<invnum> is specified, this payment (if successful) is applied to the
5193 #specified invoice.  If you don't specify an I<invnum> you might want to
5194 #call the B<apply_payments> method.
5195
5196 =cut
5197
5198 #some false laziness w/realtime_bop, not enough to make it worth merging
5199 #but some useful small subs should be pulled out
5200 sub realtime_refund_bop {
5201   my $self = shift;
5202
5203   my %options = ();
5204   if (ref($_[0]) ne 'HASH') {
5205     %options = %{$_[0]};
5206   } else {
5207     my $method = shift;
5208     %options = @_;
5209     $options{method} = $method;
5210   }
5211
5212   if ( $DEBUG ) {
5213     warn "$me realtime_refund_bop (new): $options{method} refund\n";
5214     warn "  $_ => $options{$_}\n" foreach keys %options;
5215   }
5216
5217   ###
5218   # look up the original payment and optionally a gateway for that payment
5219   ###
5220
5221   my $cust_pay = '';
5222   my $amount = $options{'amount'};
5223
5224   my( $processor, $login, $password, @bop_options, $namespace ) ;
5225   my( $auth, $order_number ) = ( '', '', '' );
5226
5227   if ( $options{'paynum'} ) {
5228
5229     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
5230     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5231       or return "Unknown paynum $options{'paynum'}";
5232     $amount ||= $cust_pay->paid;
5233
5234     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5235       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5236                 $cust_pay->paybatch;
5237     my $gatewaynum = '';
5238     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5239
5240     if ( $gatewaynum ) { #gateway for the payment to be refunded
5241
5242       my $payment_gateway =
5243         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5244       die "payment gateway $gatewaynum not found"
5245         unless $payment_gateway;
5246
5247       $processor   = $payment_gateway->gateway_module;
5248       $login       = $payment_gateway->gateway_username;
5249       $password    = $payment_gateway->gateway_password;
5250       $namespace   = $payment_gateway->gateway_namespace;
5251       @bop_options = $payment_gateway->options;
5252
5253     } else { #try the default gateway
5254
5255       my $conf_processor;
5256       my $payment_gateway =
5257         $self->agent->payment_gateway('method' => $options{method});
5258
5259       ( $conf_processor, $login, $password, $namespace ) =
5260         map { my $method = "gateway_$_"; $payment_gateway->$method }
5261           qw( module username password namespace );
5262
5263       @bop_options = $payment_gateway->gatewaynum
5264                        ? $payment_gateway->options
5265                        : @{ $payment_gateway->get('options') };
5266
5267       return "processor of payment $options{'paynum'} $processor does not".
5268              " match default processor $conf_processor"
5269         unless $processor eq $conf_processor;
5270
5271     }
5272
5273
5274   } else { # didn't specify a paynum, so look for agent gateway overrides
5275            # like a normal transaction
5276
5277     my $payment_gateway =
5278       $self->agent->payment_gateway( 'method'  => $options{method},
5279                                      #'payinfo' => $payinfo,
5280                                    );
5281     my( $processor, $login, $password, $namespace ) =
5282       map { my $method = "gateway_$_"; $payment_gateway->$method }
5283         qw( module username password namespace );
5284
5285     my @bop_options = $payment_gateway->gatewaynum
5286                         ? $payment_gateway->options
5287                         : @{ $payment_gateway->get('options') };
5288
5289   }
5290   return "neither amount nor paynum specified" unless $amount;
5291
5292   eval "use $namespace";
5293   die $@ if $@;
5294
5295   my %content = (
5296     'type'           => $options{method},
5297     'login'          => $login,
5298     'password'       => $password,
5299     'order_number'   => $order_number,
5300     'amount'         => $amount,
5301     'referer'        => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5302   );
5303   $content{authorization} = $auth
5304     if length($auth); #echeck/ACH transactions have an order # but no auth
5305                       #(at least with authorize.net)
5306
5307   my $disable_void_after;
5308   if ($conf->exists('disable_void_after')
5309       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5310     $disable_void_after = $1;
5311   }
5312
5313   #first try void if applicable
5314   if ( $cust_pay && $cust_pay->paid == $amount
5315     && (
5316       ( not defined($disable_void_after) )
5317       || ( time < ($cust_pay->_date + $disable_void_after ) )
5318     )
5319   ) {
5320     warn "  attempting void\n" if $DEBUG > 1;
5321     my $void = new Business::OnlinePayment( $processor, @bop_options );
5322     if ( $void->can('info') ) {
5323       if ( $cust_pay->payby eq 'CARD'
5324            && $void->info('CC_void_requires_card') )
5325       {
5326         $content{'card_number'} = $cust_pay->payinfo;
5327       } elsif ( $cust_pay->payby eq 'CHEK'
5328                 && $void->info('ECHECK_void_requires_account') )
5329       {
5330         ( $content{'account_number'}, $content{'routing_code'} ) =
5331           split('@', $cust_pay->payinfo);
5332         $content{'name'} = $self->get('first'). ' '. $self->get('last');
5333       }
5334     }
5335     $void->content( 'action' => 'void', %content );
5336     $void->test_transaction(1)
5337       if $conf->exists('business-onlinepayment-test_transaction');
5338     $void->submit();
5339     if ( $void->is_success ) {
5340       my $error = $cust_pay->void($options{'reason'});
5341       if ( $error ) {
5342         # gah, even with transactions.
5343         my $e = 'WARNING: Card/ACH voided but database not updated - '.
5344                 "error voiding payment: $error";
5345         warn $e;
5346         return $e;
5347       }
5348       warn "  void successful\n" if $DEBUG > 1;
5349       return '';
5350     }
5351   }
5352
5353   warn "  void unsuccessful, trying refund\n"
5354     if $DEBUG > 1;
5355
5356   #massage data
5357   my $address = $self->address1;
5358   $address .= ", ". $self->address2 if $self->address2;
5359
5360   my($payname, $payfirst, $paylast);
5361   if ( $self->payname && $options{method} ne 'ECHECK' ) {
5362     $payname = $self->payname;
5363     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5364       or return "Illegal payname $payname";
5365     ($payfirst, $paylast) = ($1, $2);
5366   } else {
5367     $payfirst = $self->getfield('first');
5368     $paylast = $self->getfield('last');
5369     $payname =  "$payfirst $paylast";
5370   }
5371
5372   my @invoicing_list = $self->invoicing_list_emailonly;
5373   if ( $conf->exists('emailinvoiceautoalways')
5374        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5375        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5376     push @invoicing_list, $self->all_emails;
5377   }
5378
5379   my $email = ($conf->exists('business-onlinepayment-email-override'))
5380               ? $conf->config('business-onlinepayment-email-override')
5381               : $invoicing_list[0];
5382
5383   my $payip = exists($options{'payip'})
5384                 ? $options{'payip'}
5385                 : $self->payip;
5386   $content{customer_ip} = $payip
5387     if length($payip);
5388
5389   my $payinfo = '';
5390   if ( $options{method} eq 'CC' ) {
5391
5392     if ( $cust_pay ) {
5393       $content{card_number} = $payinfo = $cust_pay->payinfo;
5394       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
5395         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
5396         ($content{expiration} = "$2/$1");  # where available
5397     } else {
5398       $content{card_number} = $payinfo = $self->payinfo;
5399       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
5400         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5401       $content{expiration} = "$2/$1";
5402     }
5403
5404   } elsif ( $options{method} eq 'ECHECK' ) {
5405
5406     if ( $cust_pay ) {
5407       $payinfo = $cust_pay->payinfo;
5408     } else {
5409       $payinfo = $self->payinfo;
5410     }
5411     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
5412     $content{bank_name} = $self->payname;
5413     $content{account_type} = 'CHECKING';
5414     $content{account_name} = $payname;
5415     $content{customer_org} = $self->company ? 'B' : 'I';
5416     $content{customer_ssn} = $self->ss;
5417   } elsif ( $options{method} eq 'LEC' ) {
5418     $content{phone} = $payinfo = $self->payinfo;
5419   }
5420
5421   #then try refund
5422   my $refund = new Business::OnlinePayment( $processor, @bop_options );
5423   my %sub_content = $refund->content(
5424     'action'         => 'credit',
5425     'customer_id'    => $self->custnum,
5426     'last_name'      => $paylast,
5427     'first_name'     => $payfirst,
5428     'name'           => $payname,
5429     'address'        => $address,
5430     'city'           => $self->city,
5431     'state'          => $self->state,
5432     'zip'            => $self->zip,
5433     'country'        => $self->country,
5434     'email'          => $email,
5435     'phone'          => $self->daytime || $self->night,
5436     %content, #after
5437   );
5438   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
5439     if $DEBUG > 1;
5440   $refund->test_transaction(1)
5441     if $conf->exists('business-onlinepayment-test_transaction');
5442   $refund->submit();
5443
5444   return "$processor error: ". $refund->error_message
5445     unless $refund->is_success();
5446
5447   my $paybatch = "$processor:". $refund->authorization;
5448   $paybatch .= ':'. $refund->order_number
5449     if $refund->can('order_number') && $refund->order_number;
5450
5451   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
5452     my @cust_bill_pay = $cust_pay->cust_bill_pay;
5453     last unless @cust_bill_pay;
5454     my $cust_bill_pay = pop @cust_bill_pay;
5455     my $error = $cust_bill_pay->delete;
5456     last if $error;
5457   }
5458
5459   my $cust_refund = new FS::cust_refund ( {
5460     'custnum'  => $self->custnum,
5461     'paynum'   => $options{'paynum'},
5462     'refund'   => $amount,
5463     '_date'    => '',
5464     'payby'    => $bop_method2payby{$options{method}},
5465     'payinfo'  => $payinfo,
5466     'paybatch' => $paybatch,
5467     'reason'   => $options{'reason'} || 'card or ACH refund',
5468   } );
5469   my $error = $cust_refund->insert;
5470   if ( $error ) {
5471     $cust_refund->paynum(''); #try again with no specific paynum
5472     my $error2 = $cust_refund->insert;
5473     if ( $error2 ) {
5474       # gah, even with transactions.
5475       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
5476               "error inserting refund ($processor): $error2".
5477               " (previously tried insert with paynum #$options{'paynum'}" .
5478               ": $error )";
5479       warn $e;
5480       return $e;
5481     }
5482   }
5483
5484   ''; #no error
5485
5486 }
5487
5488 =item batch_card OPTION => VALUE...
5489
5490 Adds a payment for this invoice to the pending credit card batch (see
5491 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
5492 runs the payment using a realtime gateway.
5493
5494 =cut
5495
5496 sub batch_card {
5497   my ($self, %options) = @_;
5498
5499   my $amount;
5500   if (exists($options{amount})) {
5501     $amount = $options{amount};
5502   }else{
5503     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
5504   }
5505   return '' unless $amount > 0;
5506
5507   my $invnum = delete $options{invnum};
5508   my $payby = $options{invnum} || $self->payby;  #dubious
5509
5510   if ($options{'realtime'}) {
5511     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
5512                                 $amount,
5513                                 %options,
5514                               );
5515   }
5516
5517   my $oldAutoCommit = $FS::UID::AutoCommit;
5518   local $FS::UID::AutoCommit = 0;
5519   my $dbh = dbh;
5520
5521   #this needs to handle mysql as well as Pg, like svc_acct.pm
5522   #(make it into a common function if folks need to do batching with mysql)
5523   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
5524     or return "Cannot lock pay_batch: " . $dbh->errstr;
5525
5526   my %pay_batch = (
5527     'status' => 'O',
5528     'payby'  => FS::payby->payby2payment($payby),
5529   );
5530
5531   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
5532
5533   unless ( $pay_batch ) {
5534     $pay_batch = new FS::pay_batch \%pay_batch;
5535     my $error = $pay_batch->insert;
5536     if ( $error ) {
5537       $dbh->rollback if $oldAutoCommit;
5538       die "error creating new batch: $error\n";
5539     }
5540   }
5541
5542   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
5543       'batchnum' => $pay_batch->batchnum,
5544       'custnum'  => $self->custnum,
5545   } );
5546
5547   foreach (qw( address1 address2 city state zip country payby payinfo paydate
5548                payname )) {
5549     $options{$_} = '' unless exists($options{$_});
5550   }
5551
5552   my $cust_pay_batch = new FS::cust_pay_batch ( {
5553     'batchnum' => $pay_batch->batchnum,
5554     'invnum'   => $invnum || 0,                    # is there a better value?
5555                                                    # this field should be
5556                                                    # removed...
5557                                                    # cust_bill_pay_batch now
5558     'custnum'  => $self->custnum,
5559     'last'     => $self->getfield('last'),
5560     'first'    => $self->getfield('first'),
5561     'address1' => $options{address1} || $self->address1,
5562     'address2' => $options{address2} || $self->address2,
5563     'city'     => $options{city}     || $self->city,
5564     'state'    => $options{state}    || $self->state,
5565     'zip'      => $options{zip}      || $self->zip,
5566     'country'  => $options{country}  || $self->country,
5567     'payby'    => $options{payby}    || $self->payby,
5568     'payinfo'  => $options{payinfo}  || $self->payinfo,
5569     'exp'      => $options{paydate}  || $self->paydate,
5570     'payname'  => $options{payname}  || $self->payname,
5571     'amount'   => $amount,                         # consolidating
5572   } );
5573
5574   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
5575     if $old_cust_pay_batch;
5576
5577   my $error;
5578   if ($old_cust_pay_batch) {
5579     $error = $cust_pay_batch->replace($old_cust_pay_batch)
5580   } else {
5581     $error = $cust_pay_batch->insert;
5582   }
5583
5584   if ( $error ) {
5585     $dbh->rollback if $oldAutoCommit;
5586     die $error;
5587   }
5588
5589   my $unapplied =   $self->total_unapplied_credits
5590                   + $self->total_unapplied_payments
5591                   + $self->in_transit_payments;
5592   foreach my $cust_bill ($self->open_cust_bill) {
5593     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
5594     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
5595       'invnum' => $cust_bill->invnum,
5596       'paybatchnum' => $cust_pay_batch->paybatchnum,
5597       'amount' => $cust_bill->owed,
5598       '_date' => time,
5599     };
5600     if ($unapplied >= $cust_bill_pay_batch->amount){
5601       $unapplied -= $cust_bill_pay_batch->amount;
5602       next;
5603     }else{
5604       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
5605                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
5606     }
5607     $error = $cust_bill_pay_batch->insert;
5608     if ( $error ) {
5609       $dbh->rollback if $oldAutoCommit;
5610       die $error;
5611     }
5612   }
5613
5614   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5615   '';
5616 }
5617
5618 =item apply_payments_and_credits [ OPTION => VALUE ... ]
5619
5620 Applies unapplied payments and credits.
5621
5622 In most cases, this new method should be used in place of sequential
5623 apply_payments and apply_credits methods.
5624
5625 A hash of optional arguments may be passed.  Currently "manual" is supported.
5626 If true, a payment receipt is sent instead of a statement when
5627 'payment_receipt_email' configuration option is set.
5628
5629 If there is an error, returns the error, otherwise returns false.
5630
5631 =cut
5632
5633 sub apply_payments_and_credits {
5634   my( $self, %options ) = @_;
5635
5636   local $SIG{HUP} = 'IGNORE';
5637   local $SIG{INT} = 'IGNORE';
5638   local $SIG{QUIT} = 'IGNORE';
5639   local $SIG{TERM} = 'IGNORE';
5640   local $SIG{TSTP} = 'IGNORE';
5641   local $SIG{PIPE} = 'IGNORE';
5642
5643   my $oldAutoCommit = $FS::UID::AutoCommit;
5644   local $FS::UID::AutoCommit = 0;
5645   my $dbh = dbh;
5646
5647   $self->select_for_update; #mutex
5648
5649   foreach my $cust_bill ( $self->open_cust_bill ) {
5650     my $error = $cust_bill->apply_payments_and_credits(%options);
5651     if ( $error ) {
5652       $dbh->rollback if $oldAutoCommit;
5653       return "Error applying: $error";
5654     }
5655   }
5656
5657   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5658   ''; #no error
5659
5660 }
5661
5662 =item apply_credits OPTION => VALUE ...
5663
5664 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
5665 to outstanding invoice balances in chronological order (or reverse
5666 chronological order if the I<order> option is set to B<newest>) and returns the
5667 value of any remaining unapplied credits available for refund (see
5668 L<FS::cust_refund>).
5669
5670 Dies if there is an error.
5671
5672 =cut
5673
5674 sub apply_credits {
5675   my $self = shift;
5676   my %opt = @_;
5677
5678   local $SIG{HUP} = 'IGNORE';
5679   local $SIG{INT} = 'IGNORE';
5680   local $SIG{QUIT} = 'IGNORE';
5681   local $SIG{TERM} = 'IGNORE';
5682   local $SIG{TSTP} = 'IGNORE';
5683   local $SIG{PIPE} = 'IGNORE';
5684
5685   my $oldAutoCommit = $FS::UID::AutoCommit;
5686   local $FS::UID::AutoCommit = 0;
5687   my $dbh = dbh;
5688
5689   $self->select_for_update; #mutex
5690
5691   unless ( $self->total_unapplied_credits ) {
5692     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5693     return 0;
5694   }
5695
5696   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
5697       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
5698
5699   my @invoices = $self->open_cust_bill;
5700   @invoices = sort { $b->_date <=> $a->_date } @invoices
5701     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
5702
5703   if ( $conf->exists('pkg-balances') ) {
5704     # limit @credits to those w/ a pkgnum grepped from $self
5705     my %pkgnums = ();
5706     foreach my $i (@invoices) {
5707       foreach my $li ( $i->cust_bill_pkg ) {
5708         $pkgnums{$li->pkgnum} = 1;
5709       }
5710     }
5711     @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
5712   }
5713
5714   my $credit;
5715
5716   foreach my $cust_bill ( @invoices ) {
5717
5718     if ( !defined($credit) || $credit->credited == 0) {
5719       $credit = pop @credits or last;
5720     }
5721
5722     my $owed;
5723     if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
5724       $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
5725     } else {
5726       $owed = $cust_bill->owed;
5727     }
5728     unless ( $owed > 0 ) {
5729       push @credits, $credit;
5730       next;
5731     }
5732
5733     my $amount = min( $credit->credited, $owed );
5734
5735     my $cust_credit_bill = new FS::cust_credit_bill ( {
5736       'crednum' => $credit->crednum,
5737       'invnum'  => $cust_bill->invnum,
5738       'amount'  => $amount,
5739     } );
5740     $cust_credit_bill->pkgnum( $credit->pkgnum )
5741       if $conf->exists('pkg-balances') && $credit->pkgnum;
5742     my $error = $cust_credit_bill->insert;
5743     if ( $error ) {
5744       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5745       die $error;
5746     }
5747
5748     redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
5749
5750   }
5751
5752   my $total_unapplied_credits = $self->total_unapplied_credits;
5753
5754   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5755
5756   return $total_unapplied_credits;
5757 }
5758
5759 =item apply_payments  [ OPTION => VALUE ... ]
5760
5761 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
5762 to outstanding invoice balances in chronological order.
5763
5764  #and returns the value of any remaining unapplied payments.
5765
5766 A hash of optional arguments may be passed.  Currently "manual" is supported.
5767 If true, a payment receipt is sent instead of a statement when
5768 'payment_receipt_email' configuration option is set.
5769
5770 Dies if there is an error.
5771
5772 =cut
5773
5774 sub apply_payments {
5775   my( $self, %options ) = @_;
5776
5777   local $SIG{HUP} = 'IGNORE';
5778   local $SIG{INT} = 'IGNORE';
5779   local $SIG{QUIT} = 'IGNORE';
5780   local $SIG{TERM} = 'IGNORE';
5781   local $SIG{TSTP} = 'IGNORE';
5782   local $SIG{PIPE} = 'IGNORE';
5783
5784   my $oldAutoCommit = $FS::UID::AutoCommit;
5785   local $FS::UID::AutoCommit = 0;
5786   my $dbh = dbh;
5787
5788   $self->select_for_update; #mutex
5789
5790   #return 0 unless
5791
5792   my @payments = sort { $b->_date <=> $a->_date }
5793                  grep { $_->unapplied > 0 }
5794                  $self->cust_pay;
5795
5796   my @invoices = sort { $a->_date <=> $b->_date}
5797                  grep { $_->owed > 0 }
5798                  $self->cust_bill;
5799
5800   if ( $conf->exists('pkg-balances') ) {
5801     # limit @payments to those w/ a pkgnum grepped from $self
5802     my %pkgnums = ();
5803     foreach my $i (@invoices) {
5804       foreach my $li ( $i->cust_bill_pkg ) {
5805         $pkgnums{$li->pkgnum} = 1;
5806       }
5807     }
5808     @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
5809   }
5810
5811   my $payment;
5812
5813   foreach my $cust_bill ( @invoices ) {
5814
5815     if ( !defined($payment) || $payment->unapplied == 0 ) {
5816       $payment = pop @payments or last;
5817     }
5818
5819     my $owed;
5820     if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
5821       $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
5822     } else {
5823       $owed = $cust_bill->owed;
5824     }
5825     unless ( $owed > 0 ) {
5826       push @payments, $payment;
5827       next;
5828     }
5829
5830     my $amount = min( $payment->unapplied, $owed );
5831
5832     my $cust_bill_pay = new FS::cust_bill_pay ( {
5833       'paynum' => $payment->paynum,
5834       'invnum' => $cust_bill->invnum,
5835       'amount' => $amount,
5836     } );
5837     $cust_bill_pay->pkgnum( $payment->pkgnum )
5838       if $conf->exists('pkg-balances') && $payment->pkgnum;
5839     my $error = $cust_bill_pay->insert(%options);
5840     if ( $error ) {
5841       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5842       die $error;
5843     }
5844
5845     redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
5846
5847   }
5848
5849   my $total_unapplied_payments = $self->total_unapplied_payments;
5850
5851   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5852
5853   return $total_unapplied_payments;
5854 }
5855
5856 =item total_owed
5857
5858 Returns the total owed for this customer on all invoices
5859 (see L<FS::cust_bill/owed>).
5860
5861 =cut
5862
5863 sub total_owed {
5864   my $self = shift;
5865   $self->total_owed_date(2145859200); #12/31/2037
5866 }
5867
5868 =item total_owed_date TIME
5869
5870 Returns the total owed for this customer on all invoices with date earlier than
5871 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
5872 see L<Time::Local> and L<Date::Parse> for conversion functions.
5873
5874 =cut
5875
5876 sub total_owed_date {
5877   my $self = shift;
5878   my $time = shift;
5879
5880 #  my $custnum = $self->custnum;
5881 #
5882 #  my $owed_sql = FS::cust_bill->owed_sql;
5883 #
5884 #  my $sql = "
5885 #    SELECT SUM($owed_sql) FROM cust_bill
5886 #      WHERE custnum = $custnum
5887 #        AND _date <= $time
5888 #  ";
5889 #
5890 #  my $sth = dbh->prepare($sql) or die dbh->errstr;
5891 #  $sth->execute() or die $sth->errstr;
5892 #
5893 #  return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] );
5894
5895   my $total_bill = 0;
5896   foreach my $cust_bill (
5897     grep { $_->_date <= $time }
5898       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
5899   ) {
5900     $total_bill += $cust_bill->owed;
5901   }
5902   sprintf( "%.2f", $total_bill );
5903
5904 }
5905
5906 =item total_owed_pkgnum PKGNUM
5907
5908 Returns the total owed on all invoices for this customer's specific package
5909 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
5910
5911 =cut
5912
5913 sub total_owed_pkgnum {
5914   my( $self, $pkgnum ) = @_;
5915   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
5916 }
5917
5918 =item total_owed_date_pkgnum TIME PKGNUM
5919
5920 Returns the total owed for this customer's specific package when using
5921 experimental package balances on all invoices with date earlier than
5922 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
5923 see L<Time::Local> and L<Date::Parse> for conversion functions.
5924
5925 =cut
5926
5927 sub total_owed_date_pkgnum {
5928   my( $self, $time, $pkgnum ) = @_;
5929
5930   my $total_bill = 0;
5931   foreach my $cust_bill (
5932     grep { $_->_date <= $time }
5933       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
5934   ) {
5935     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
5936   }
5937   sprintf( "%.2f", $total_bill );
5938
5939 }
5940
5941 =item total_paid
5942
5943 Returns the total amount of all payments.
5944
5945 =cut
5946
5947 sub total_paid {
5948   my $self = shift;
5949   my $total = 0;
5950   $total += $_->paid foreach $self->cust_pay;
5951   sprintf( "%.2f", $total );
5952 }
5953
5954 =item total_unapplied_credits
5955
5956 Returns the total outstanding credit (see L<FS::cust_credit>) for this
5957 customer.  See L<FS::cust_credit/credited>.
5958
5959 =item total_credited
5960
5961 Old name for total_unapplied_credits.  Don't use.
5962
5963 =cut
5964
5965 sub total_credited {
5966   #carp "total_credited deprecated, use total_unapplied_credits";
5967   shift->total_unapplied_credits(@_);
5968 }
5969
5970 sub total_unapplied_credits {
5971   my $self = shift;
5972   my $total_credit = 0;
5973   $total_credit += $_->credited foreach $self->cust_credit;
5974   sprintf( "%.2f", $total_credit );
5975 }
5976
5977 =item total_unapplied_credits_pkgnum PKGNUM
5978
5979 Returns the total outstanding credit (see L<FS::cust_credit>) for this
5980 customer.  See L<FS::cust_credit/credited>.
5981
5982 =cut
5983
5984 sub total_unapplied_credits_pkgnum {
5985   my( $self, $pkgnum ) = @_;
5986   my $total_credit = 0;
5987   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
5988   sprintf( "%.2f", $total_credit );
5989 }
5990
5991
5992 =item total_unapplied_payments
5993
5994 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
5995 See L<FS::cust_pay/unapplied>.
5996
5997 =cut
5998
5999 sub total_unapplied_payments {
6000   my $self = shift;
6001   my $total_unapplied = 0;
6002   $total_unapplied += $_->unapplied foreach $self->cust_pay;
6003   sprintf( "%.2f", $total_unapplied );
6004 }
6005
6006 =item total_unapplied_payments_pkgnum PKGNUM
6007
6008 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
6009 specific package when using experimental package balances.  See
6010 L<FS::cust_pay/unapplied>.
6011
6012 =cut
6013
6014 sub total_unapplied_payments_pkgnum {
6015   my( $self, $pkgnum ) = @_;
6016   my $total_unapplied = 0;
6017   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
6018   sprintf( "%.2f", $total_unapplied );
6019 }
6020
6021
6022 =item total_unapplied_refunds
6023
6024 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6025 customer.  See L<FS::cust_refund/unapplied>.
6026
6027 =cut
6028
6029 sub total_unapplied_refunds {
6030   my $self = shift;
6031   my $total_unapplied = 0;
6032   $total_unapplied += $_->unapplied foreach $self->cust_refund;
6033   sprintf( "%.2f", $total_unapplied );
6034 }
6035
6036 =item balance
6037
6038 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6039 total_unapplied_credits minus total_unapplied_payments).
6040
6041 =cut
6042
6043 sub balance {
6044   my $self = shift;
6045   sprintf( "%.2f",
6046       $self->total_owed
6047     + $self->total_unapplied_refunds
6048     - $self->total_unapplied_credits
6049     - $self->total_unapplied_payments
6050   );
6051 }
6052
6053 =item balance_date TIME
6054
6055 Returns the balance for this customer, only considering invoices with date
6056 earlier than TIME (total_owed_date minus total_credited minus
6057 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
6058 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
6059 functions.
6060
6061 =cut
6062
6063 sub balance_date {
6064   my $self = shift;
6065   my $time = shift;
6066   sprintf( "%.2f",
6067         $self->total_owed_date($time)
6068       + $self->total_unapplied_refunds
6069       - $self->total_unapplied_credits
6070       - $self->total_unapplied_payments
6071   );
6072 }
6073
6074 =item balance_date_range START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
6075
6076 Returns the balance for this customer, only considering invoices with date
6077 earlier than START_TIME, and optionally not later than END_TIME
6078 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
6079
6080 Times are specified as SQL fragments or numeric
6081 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
6082 L<Date::Parse> for conversion functions.  The empty string can be passed
6083 to disable that time constraint completely.
6084
6085 Available options are:
6086
6087 =over 4
6088
6089 =item unapplied_date
6090
6091 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)
6092
6093 =back
6094
6095 =cut
6096
6097 sub balance_date_range {
6098   my $self = shift;
6099   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
6100             ') FROM cust_main WHERE custnum='. $self->custnum;
6101   sprintf( "%.2f", $self->scalar_sql($sql) );
6102 }
6103
6104 =item balance_pkgnum PKGNUM
6105
6106 Returns the balance for this customer's specific package when using
6107 experimental package balances (total_owed plus total_unrefunded, minus
6108 total_unapplied_credits minus total_unapplied_payments)
6109
6110 =cut
6111
6112 sub balance_pkgnum {
6113   my( $self, $pkgnum ) = @_;
6114
6115   sprintf( "%.2f",
6116       $self->total_owed_pkgnum($pkgnum)
6117 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
6118 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
6119     - $self->total_unapplied_credits_pkgnum($pkgnum)
6120     - $self->total_unapplied_payments_pkgnum($pkgnum)
6121   );
6122 }
6123
6124 =item in_transit_payments
6125
6126 Returns the total of requests for payments for this customer pending in
6127 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
6128
6129 =cut
6130
6131 sub in_transit_payments {
6132   my $self = shift;
6133   my $in_transit_payments = 0;
6134   foreach my $pay_batch ( qsearch('pay_batch', {
6135     'status' => 'I',
6136   } ) ) {
6137     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6138       'batchnum' => $pay_batch->batchnum,
6139       'custnum' => $self->custnum,
6140     } ) ) {
6141       $in_transit_payments += $cust_pay_batch->amount;
6142     }
6143   }
6144   sprintf( "%.2f", $in_transit_payments );
6145 }
6146
6147 =item payment_info
6148
6149 Returns a hash of useful information for making a payment.
6150
6151 =over 4
6152
6153 =item balance
6154
6155 Current balance.
6156
6157 =item payby
6158
6159 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6160 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6161 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6162
6163 =back
6164
6165 For credit card transactions:
6166
6167 =over 4
6168
6169 =item card_type 1
6170
6171 =item payname
6172
6173 Exact name on card
6174
6175 =back
6176
6177 For electronic check transactions:
6178
6179 =over 4
6180
6181 =item stateid_state
6182
6183 =back
6184
6185 =cut
6186
6187 sub payment_info {
6188   my $self = shift;
6189
6190   my %return = ();
6191
6192   $return{balance} = $self->balance;
6193
6194   $return{payname} = $self->payname
6195                      || ( $self->first. ' '. $self->get('last') );
6196
6197   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6198
6199   $return{payby} = $self->payby;
6200   $return{stateid_state} = $self->stateid_state;
6201
6202   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6203     $return{card_type} = cardtype($self->payinfo);
6204     $return{payinfo} = $self->paymask;
6205
6206     @return{'month', 'year'} = $self->paydate_monthyear;
6207
6208   }
6209
6210   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6211     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6212     $return{payinfo1} = $payinfo1;
6213     $return{payinfo2} = $payinfo2;
6214     $return{paytype}  = $self->paytype;
6215     $return{paystate} = $self->paystate;
6216
6217   }
6218
6219   #doubleclick protection
6220   my $_date = time;
6221   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6222
6223   %return;
6224
6225 }
6226
6227 =item paydate_monthyear
6228
6229 Returns a two-element list consisting of the month and year of this customer's
6230 paydate (credit card expiration date for CARD customers)
6231
6232 =cut
6233
6234 sub paydate_monthyear {
6235   my $self = shift;
6236   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6237     ( $2, $1 );
6238   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6239     ( $1, $3 );
6240   } else {
6241     ('', '');
6242   }
6243 }
6244
6245 =item tax_exemption TAXNAME
6246
6247 =cut
6248
6249 sub tax_exemption {
6250   my( $self, $taxname ) = @_;
6251
6252   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
6253                                      'taxname' => $taxname,
6254                                    },
6255           );
6256 }
6257
6258 =item cust_main_exemption
6259
6260 =cut
6261
6262 sub cust_main_exemption {
6263   my $self = shift;
6264   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
6265 }
6266
6267 =item invoicing_list [ ARRAYREF ]
6268
6269 If an arguement is given, sets these email addresses as invoice recipients
6270 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
6271 (except as warnings), so use check_invoicing_list first.
6272
6273 Returns a list of email addresses (with svcnum entries expanded).
6274
6275 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
6276 check it without disturbing anything by passing nothing.
6277
6278 This interface may change in the future.
6279
6280 =cut
6281
6282 sub invoicing_list {
6283   my( $self, $arrayref ) = @_;
6284
6285   if ( $arrayref ) {
6286     my @cust_main_invoice;
6287     if ( $self->custnum ) {
6288       @cust_main_invoice =
6289         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6290     } else {
6291       @cust_main_invoice = ();
6292     }
6293     foreach my $cust_main_invoice ( @cust_main_invoice ) {
6294       #warn $cust_main_invoice->destnum;
6295       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6296         #warn $cust_main_invoice->destnum;
6297         my $error = $cust_main_invoice->delete;
6298         warn $error if $error;
6299       }
6300     }
6301     if ( $self->custnum ) {
6302       @cust_main_invoice =
6303         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6304     } else {
6305       @cust_main_invoice = ();
6306     }
6307     my %seen = map { $_->address => 1 } @cust_main_invoice;
6308     foreach my $address ( @{$arrayref} ) {
6309       next if exists $seen{$address} && $seen{$address};
6310       $seen{$address} = 1;
6311       my $cust_main_invoice = new FS::cust_main_invoice ( {
6312         'custnum' => $self->custnum,
6313         'dest'    => $address,
6314       } );
6315       my $error = $cust_main_invoice->insert;
6316       warn $error if $error;
6317     }
6318   }
6319
6320   if ( $self->custnum ) {
6321     map { $_->address }
6322       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6323   } else {
6324     ();
6325   }
6326
6327 }
6328
6329 =item check_invoicing_list ARRAYREF
6330
6331 Checks these arguements as valid input for the invoicing_list method.  If there
6332 is an error, returns the error, otherwise returns false.
6333
6334 =cut
6335
6336 sub check_invoicing_list {
6337   my( $self, $arrayref ) = @_;
6338
6339   foreach my $address ( @$arrayref ) {
6340
6341     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6342       return 'Can\'t add FAX invoice destination with a blank FAX number.';
6343     }
6344
6345     my $cust_main_invoice = new FS::cust_main_invoice ( {
6346       'custnum' => $self->custnum,
6347       'dest'    => $address,
6348     } );
6349     my $error = $self->custnum
6350                 ? $cust_main_invoice->check
6351                 : $cust_main_invoice->checkdest
6352     ;
6353     return $error if $error;
6354
6355   }
6356
6357   return "Email address required"
6358     if $conf->exists('cust_main-require_invoicing_list_email')
6359     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6360
6361   '';
6362 }
6363
6364 =item set_default_invoicing_list
6365
6366 Sets the invoicing list to all accounts associated with this customer,
6367 overwriting any previous invoicing list.
6368
6369 =cut
6370
6371 sub set_default_invoicing_list {
6372   my $self = shift;
6373   $self->invoicing_list($self->all_emails);
6374 }
6375
6376 =item all_emails
6377
6378 Returns the email addresses of all accounts provisioned for this customer.
6379
6380 =cut
6381
6382 sub all_emails {
6383   my $self = shift;
6384   my %list;
6385   foreach my $cust_pkg ( $self->all_pkgs ) {
6386     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6387     my @svc_acct =
6388       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6389         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6390           @cust_svc;
6391     $list{$_}=1 foreach map { $_->email } @svc_acct;
6392   }
6393   keys %list;
6394 }
6395
6396 =item invoicing_list_addpost
6397
6398 Adds postal invoicing to this customer.  If this customer is already configured
6399 to receive postal invoices, does nothing.
6400
6401 =cut
6402
6403 sub invoicing_list_addpost {
6404   my $self = shift;
6405   return if grep { $_ eq 'POST' } $self->invoicing_list;
6406   my @invoicing_list = $self->invoicing_list;
6407   push @invoicing_list, 'POST';
6408   $self->invoicing_list(\@invoicing_list);
6409 }
6410
6411 =item invoicing_list_emailonly
6412
6413 Returns the list of email invoice recipients (invoicing_list without non-email
6414 destinations such as POST and FAX).
6415
6416 =cut
6417
6418 sub invoicing_list_emailonly {
6419   my $self = shift;
6420   warn "$me invoicing_list_emailonly called"
6421     if $DEBUG;
6422   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6423 }
6424
6425 =item invoicing_list_emailonly_scalar
6426
6427 Returns the list of email invoice recipients (invoicing_list without non-email
6428 destinations such as POST and FAX) as a comma-separated scalar.
6429
6430 =cut
6431
6432 sub invoicing_list_emailonly_scalar {
6433   my $self = shift;
6434   warn "$me invoicing_list_emailonly_scalar called"
6435     if $DEBUG;
6436   join(', ', $self->invoicing_list_emailonly);
6437 }
6438
6439 =item referral_custnum_cust_main
6440
6441 Returns the customer who referred this customer (or the empty string, if
6442 this customer was not referred).
6443
6444 Note the difference with referral_cust_main method: This method,
6445 referral_custnum_cust_main returns the single customer (if any) who referred
6446 this customer, while referral_cust_main returns an array of customers referred
6447 BY this customer.
6448
6449 =cut
6450
6451 sub referral_custnum_cust_main {
6452   my $self = shift;
6453   return '' unless $self->referral_custnum;
6454   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6455 }
6456
6457 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6458
6459 Returns an array of customers referred by this customer (referral_custnum set
6460 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
6461 customers referred by customers referred by this customer and so on, inclusive.
6462 The default behavior is DEPTH 1 (no recursion).
6463
6464 Note the difference with referral_custnum_cust_main method: This method,
6465 referral_cust_main, returns an array of customers referred BY this customer,
6466 while referral_custnum_cust_main returns the single customer (if any) who
6467 referred this customer.
6468
6469 =cut
6470
6471 sub referral_cust_main {
6472   my $self = shift;
6473   my $depth = @_ ? shift : 1;
6474   my $exclude = @_ ? shift : {};
6475
6476   my @cust_main =
6477     map { $exclude->{$_->custnum}++; $_; }
6478       grep { ! $exclude->{ $_->custnum } }
6479         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6480
6481   if ( $depth > 1 ) {
6482     push @cust_main,
6483       map { $_->referral_cust_main($depth-1, $exclude) }
6484         @cust_main;
6485   }
6486
6487   @cust_main;
6488 }
6489
6490 =item referral_cust_main_ncancelled
6491
6492 Same as referral_cust_main, except only returns customers with uncancelled
6493 packages.
6494
6495 =cut
6496
6497 sub referral_cust_main_ncancelled {
6498   my $self = shift;
6499   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6500 }
6501
6502 =item referral_cust_pkg [ DEPTH ]
6503
6504 Like referral_cust_main, except returns a flat list of all unsuspended (and
6505 uncancelled) packages for each customer.  The number of items in this list may
6506 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6507
6508 =cut
6509
6510 sub referral_cust_pkg {
6511   my $self = shift;
6512   my $depth = @_ ? shift : 1;
6513
6514   map { $_->unsuspended_pkgs }
6515     grep { $_->unsuspended_pkgs }
6516       $self->referral_cust_main($depth);
6517 }
6518
6519 =item referring_cust_main
6520
6521 Returns the single cust_main record for the customer who referred this customer
6522 (referral_custnum), or false.
6523
6524 =cut
6525
6526 sub referring_cust_main {
6527   my $self = shift;
6528   return '' unless $self->referral_custnum;
6529   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6530 }
6531
6532 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6533
6534 Applies a credit to this customer.  If there is an error, returns the error,
6535 otherwise returns false.
6536
6537 REASON can be a text string, an FS::reason object, or a scalar reference to
6538 a reasonnum.  If a text string, it will be automatically inserted as a new
6539 reason, and a 'reason_type' option must be passed to indicate the
6540 FS::reason_type for the new reason.
6541
6542 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6543
6544 Any other options are passed to FS::cust_credit::insert.
6545
6546 =cut
6547
6548 sub credit {
6549   my( $self, $amount, $reason, %options ) = @_;
6550
6551   my $cust_credit = new FS::cust_credit {
6552     'custnum' => $self->custnum,
6553     'amount'  => $amount,
6554   };
6555
6556   if ( ref($reason) ) {
6557
6558     if ( ref($reason) eq 'SCALAR' ) {
6559       $cust_credit->reasonnum( $$reason );
6560     } else {
6561       $cust_credit->reasonnum( $reason->reasonnum );
6562     }
6563
6564   } else {
6565     $cust_credit->set('reason', $reason)
6566   }
6567
6568   for (qw( addlinfo eventnum )) {
6569     $cust_credit->$_( delete $options{$_} )
6570       if exists($options{$_});
6571   }
6572
6573   $cust_credit->insert(%options);
6574
6575 }
6576
6577 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6578
6579 Creates a one-time charge for this customer.  If there is an error, returns
6580 the error, otherwise returns false.
6581
6582 New-style, with a hashref of options:
6583
6584   my $error = $cust_main->charge(
6585                                   {
6586                                     'amount'     => 54.32,
6587                                     'quantity'   => 1,
6588                                     'start_date' => str2time('7/4/2009'),
6589                                     'pkg'        => 'Description',
6590                                     'comment'    => 'Comment',
6591                                     'additional' => [], #extra invoice detail
6592                                     'classnum'   => 1,  #pkg_class
6593
6594                                     'setuptax'   => '', # or 'Y' for tax exempt
6595
6596                                     #internal taxation
6597                                     'taxclass'   => 'Tax class',
6598
6599                                     #vendor taxation
6600                                     'taxproduct' => 2,  #part_pkg_taxproduct
6601                                     'override'   => {}, #XXX describe
6602
6603                                     #will be filled in with the new object
6604                                     'cust_pkg_ref' => \$cust_pkg,
6605
6606                                     #generate an invoice immediately
6607                                     'bill_now' => 0,
6608                                     'invoice_terms' => '', #with these terms
6609                                   }
6610                                 );
6611
6612 Old-style:
6613
6614   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
6615
6616 =cut
6617
6618 sub charge {
6619   my $self = shift;
6620   my ( $amount, $quantity, $start_date, $classnum );
6621   my ( $pkg, $comment, $additional );
6622   my ( $setuptax, $taxclass );   #internal taxes
6623   my ( $taxproduct, $override ); #vendor (CCH) taxes
6624   my $no_auto = '';
6625   my $cust_pkg_ref = '';
6626   my ( $bill_now, $invoice_terms ) = ( 0, '' );
6627   if ( ref( $_[0] ) ) {
6628     $amount     = $_[0]->{amount};
6629     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6630     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
6631     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
6632     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6633     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
6634                                            : '$'. sprintf("%.2f",$amount);
6635     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6636     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6637     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6638     $additional = $_[0]->{additional} || [];
6639     $taxproduct = $_[0]->{taxproductnum};
6640     $override   = { '' => $_[0]->{tax_override} };
6641     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
6642     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
6643     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
6644   } else {
6645     $amount     = shift;
6646     $quantity   = 1;
6647     $start_date = '';
6648     $pkg        = @_ ? shift : 'One-time charge';
6649     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
6650     $setuptax   = '';
6651     $taxclass   = @_ ? shift : '';
6652     $additional = [];
6653   }
6654
6655   local $SIG{HUP} = 'IGNORE';
6656   local $SIG{INT} = 'IGNORE';
6657   local $SIG{QUIT} = 'IGNORE';
6658   local $SIG{TERM} = 'IGNORE';
6659   local $SIG{TSTP} = 'IGNORE';
6660   local $SIG{PIPE} = 'IGNORE';
6661
6662   my $oldAutoCommit = $FS::UID::AutoCommit;
6663   local $FS::UID::AutoCommit = 0;
6664   my $dbh = dbh;
6665
6666   my $part_pkg = new FS::part_pkg ( {
6667     'pkg'           => $pkg,
6668     'comment'       => $comment,
6669     'plan'          => 'flat',
6670     'freq'          => 0,
6671     'disabled'      => 'Y',
6672     'classnum'      => ( $classnum ? $classnum : '' ),
6673     'setuptax'      => $setuptax,
6674     'taxclass'      => $taxclass,
6675     'taxproductnum' => $taxproduct,
6676   } );
6677
6678   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6679                         ( 0 .. @$additional - 1 )
6680                   ),
6681                   'additional_count' => scalar(@$additional),
6682                   'setup_fee' => $amount,
6683                 );
6684
6685   my $error = $part_pkg->insert( options       => \%options,
6686                                  tax_overrides => $override,
6687                                );
6688   if ( $error ) {
6689     $dbh->rollback if $oldAutoCommit;
6690     return $error;
6691   }
6692
6693   my $pkgpart = $part_pkg->pkgpart;
6694   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6695   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6696     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6697     $error = $type_pkgs->insert;
6698     if ( $error ) {
6699       $dbh->rollback if $oldAutoCommit;
6700       return $error;
6701     }
6702   }
6703
6704   my $cust_pkg = new FS::cust_pkg ( {
6705     'custnum'    => $self->custnum,
6706     'pkgpart'    => $pkgpart,
6707     'quantity'   => $quantity,
6708     'start_date' => $start_date,
6709     'no_auto'    => $no_auto,
6710   } );
6711
6712   $error = $cust_pkg->insert;
6713   if ( $error ) {
6714     $dbh->rollback if $oldAutoCommit;
6715     return $error;
6716   } elsif ( $cust_pkg_ref ) {
6717     ${$cust_pkg_ref} = $cust_pkg;
6718   }
6719
6720   if ( $bill_now ) {
6721     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
6722                              'pkg_list'      => [ $cust_pkg ],
6723                            );
6724     if ( $error ) {
6725       $dbh->rollback if $oldAutoCommit;
6726       return $error;
6727     }
6728   }
6729
6730   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6731   return '';
6732
6733 }
6734
6735 #=item charge_postal_fee
6736 #
6737 #Applies a one time charge this customer.  If there is an error,
6738 #returns the error, returns the cust_pkg charge object or false
6739 #if there was no charge.
6740 #
6741 #=cut
6742 #
6743 # This should be a customer event.  For that to work requires that bill
6744 # also be a customer event.
6745
6746 sub charge_postal_fee {
6747   my $self = shift;
6748
6749   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
6750   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
6751
6752   my $cust_pkg = new FS::cust_pkg ( {
6753     'custnum'  => $self->custnum,
6754     'pkgpart'  => $pkgpart,
6755     'quantity' => 1,
6756   } );
6757
6758   my $error = $cust_pkg->insert;
6759   $error ? $error : $cust_pkg;
6760 }
6761
6762 =item cust_bill
6763
6764 Returns all the invoices (see L<FS::cust_bill>) for this customer.
6765
6766 =cut
6767
6768 sub cust_bill {
6769   my $self = shift;
6770   map { $_ } #return $self->num_cust_bill unless wantarray;
6771   sort { $a->_date <=> $b->_date }
6772     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6773 }
6774
6775 =item open_cust_bill
6776
6777 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
6778 customer.
6779
6780 =cut
6781
6782 sub open_cust_bill {
6783   my $self = shift;
6784
6785   qsearch({
6786     'table'     => 'cust_bill',
6787     'hashref'   => { 'custnum' => $self->custnum, },
6788     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
6789     'order_by'  => 'ORDER BY _date ASC',
6790   });
6791
6792 }
6793
6794 =item cust_statements
6795
6796 Returns all the statements (see L<FS::cust_statement>) for this customer.
6797
6798 =cut
6799
6800 sub cust_statement {
6801   my $self = shift;
6802   map { $_ } #return $self->num_cust_statement unless wantarray;
6803   sort { $a->_date <=> $b->_date }
6804     qsearch('cust_statement', { 'custnum' => $self->custnum, } )
6805 }
6806
6807 =item cust_credit
6808
6809 Returns all the credits (see L<FS::cust_credit>) for this customer.
6810
6811 =cut
6812
6813 sub cust_credit {
6814   my $self = shift;
6815   map { $_ } #return $self->num_cust_credit unless wantarray;
6816   sort { $a->_date <=> $b->_date }
6817     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
6818 }
6819
6820 =item cust_credit_pkgnum
6821
6822 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
6823 package when using experimental package balances.
6824
6825 =cut
6826
6827 sub cust_credit_pkgnum {
6828   my( $self, $pkgnum ) = @_;
6829   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
6830   sort { $a->_date <=> $b->_date }
6831     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
6832                               'pkgnum'  => $pkgnum,
6833                             }
6834     );
6835 }
6836
6837 =item cust_pay
6838
6839 Returns all the payments (see L<FS::cust_pay>) for this customer.
6840
6841 =cut
6842
6843 sub cust_pay {
6844   my $self = shift;
6845   return $self->num_cust_pay unless wantarray;
6846   sort { $a->_date <=> $b->_date }
6847     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
6848 }
6849
6850 =item num_cust_pay
6851
6852 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
6853 called automatically when the cust_pay method is used in a scalar context.
6854
6855 =cut
6856
6857 sub num_cust_pay {
6858   my $self = shift;
6859   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
6860   my $sth = dbh->prepare($sql) or die dbh->errstr;
6861   $sth->execute($self->custnum) or die $sth->errstr;
6862   $sth->fetchrow_arrayref->[0];
6863 }
6864
6865 =item cust_pay_pkgnum
6866
6867 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
6868 package when using experimental package balances.
6869
6870 =cut
6871
6872 sub cust_pay_pkgnum {
6873   my( $self, $pkgnum ) = @_;
6874   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
6875   sort { $a->_date <=> $b->_date }
6876     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
6877                            'pkgnum'  => $pkgnum,
6878                          }
6879     );
6880 }
6881
6882 =item cust_pay_void
6883
6884 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
6885
6886 =cut
6887
6888 sub cust_pay_void {
6889   my $self = shift;
6890   map { $_ } #return $self->num_cust_pay_void unless wantarray;
6891   sort { $a->_date <=> $b->_date }
6892     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
6893 }
6894
6895 =item cust_pay_batch
6896
6897 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
6898
6899 =cut
6900
6901 sub cust_pay_batch {
6902   my $self = shift;
6903   map { $_ } #return $self->num_cust_pay_batch unless wantarray;
6904   sort { $a->paybatchnum <=> $b->paybatchnum }
6905     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
6906 }
6907
6908 =item cust_pay_pending
6909
6910 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
6911 (without status "done").
6912
6913 =cut
6914
6915 sub cust_pay_pending {
6916   my $self = shift;
6917   return $self->num_cust_pay_pending unless wantarray;
6918   sort { $a->_date <=> $b->_date }
6919     qsearch( 'cust_pay_pending', {
6920                                    'custnum' => $self->custnum,
6921                                    'status'  => { op=>'!=', value=>'done' },
6922                                  },
6923            );
6924 }
6925
6926 =item num_cust_pay_pending
6927
6928 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
6929 customer (without status "done").  Also called automatically when the
6930 cust_pay_pending method is used in a scalar context.
6931
6932 =cut
6933
6934 sub num_cust_pay_pending {
6935   my $self = shift;
6936   my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
6937             "   WHERE custnum = ? AND status != 'done' ";
6938   my $sth = dbh->prepare($sql) or die dbh->errstr;
6939   $sth->execute($self->custnum) or die $sth->errstr;
6940   $sth->fetchrow_arrayref->[0];
6941 }
6942
6943 =item cust_refund
6944
6945 Returns all the refunds (see L<FS::cust_refund>) for this customer.
6946
6947 =cut
6948
6949 sub cust_refund {
6950   my $self = shift;
6951   map { $_ } #return $self->num_cust_refund unless wantarray;
6952   sort { $a->_date <=> $b->_date }
6953     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
6954 }
6955
6956 =item display_custnum
6957
6958 Returns the displayed customer number for this customer: agent_custid if
6959 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
6960
6961 =cut
6962
6963 sub display_custnum {
6964   my $self = shift;
6965   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
6966     return $self->agent_custid;
6967   } else {
6968     return $self->custnum;
6969   }
6970 }
6971
6972 =item name
6973
6974 Returns a name string for this customer, either "Company (Last, First)" or
6975 "Last, First".
6976
6977 =cut
6978
6979 sub name {
6980   my $self = shift;
6981   my $name = $self->contact;
6982   $name = $self->company. " ($name)" if $self->company;
6983   $name;
6984 }
6985
6986 =item ship_name
6987
6988 Returns a name string for this (service/shipping) contact, either
6989 "Company (Last, First)" or "Last, First".
6990
6991 =cut
6992
6993 sub ship_name {
6994   my $self = shift;
6995   if ( $self->get('ship_last') ) {
6996     my $name = $self->ship_contact;
6997     $name = $self->ship_company. " ($name)" if $self->ship_company;
6998     $name;
6999   } else {
7000     $self->name;
7001   }
7002 }
7003
7004 =item name_short
7005
7006 Returns a name string for this customer, either "Company" or "First Last".
7007
7008 =cut
7009
7010 sub name_short {
7011   my $self = shift;
7012   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
7013 }
7014
7015 =item ship_name_short
7016
7017 Returns a name string for this (service/shipping) contact, either "Company"
7018 or "First Last".
7019
7020 =cut
7021
7022 sub ship_name_short {
7023   my $self = shift;
7024   if ( $self->get('ship_last') ) {
7025     $self->ship_company !~ /^\s*$/
7026       ? $self->ship_company
7027       : $self->ship_contact_firstlast;
7028   } else {
7029     $self->name_company_or_firstlast;
7030   }
7031 }
7032
7033 =item contact
7034
7035 Returns this customer's full (billing) contact name only, "Last, First"
7036
7037 =cut
7038
7039 sub contact {
7040   my $self = shift;
7041   $self->get('last'). ', '. $self->first;
7042 }
7043
7044 =item ship_contact
7045
7046 Returns this customer's full (shipping) contact name only, "Last, First"
7047
7048 =cut
7049
7050 sub ship_contact {
7051   my $self = shift;
7052   $self->get('ship_last')
7053     ? $self->get('ship_last'). ', '. $self->ship_first
7054     : $self->contact;
7055 }
7056
7057 =item contact_firstlast
7058
7059 Returns this customers full (billing) contact name only, "First Last".
7060
7061 =cut
7062
7063 sub contact_firstlast {
7064   my $self = shift;
7065   $self->first. ' '. $self->get('last');
7066 }
7067
7068 =item ship_contact_firstlast
7069
7070 Returns this customer's full (shipping) contact name only, "First Last".
7071
7072 =cut
7073
7074 sub ship_contact_firstlast {
7075   my $self = shift;
7076   $self->get('ship_last')
7077     ? $self->first. ' '. $self->get('ship_last')
7078     : $self->contact_firstlast;
7079 }
7080
7081 =item country_full
7082
7083 Returns this customer's full country name
7084
7085 =cut
7086
7087 sub country_full {
7088   my $self = shift;
7089   code2country($self->country);
7090 }
7091
7092 =item geocode DATA_VENDOR
7093
7094 Returns a value for the customer location as encoded by DATA_VENDOR.
7095 Currently this only makes sense for "CCH" as DATA_VENDOR.
7096
7097 =cut
7098
7099 sub geocode {
7100   my ($self, $data_vendor) = (shift, shift);  #always cch for now
7101
7102   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
7103   return $geocode if $geocode;
7104
7105   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7106                ? 'ship_'
7107                : '';
7108
7109   my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7110     if $self->country eq 'US';
7111
7112   $zip ||= '';
7113   $plus4 ||= '';
7114   #CCH specific location stuff
7115   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7116
7117   my @cust_tax_location =
7118     qsearch( {
7119                'table'     => 'cust_tax_location',
7120                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7121                'extra_sql' => $extra_sql,
7122                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
7123              }
7124            );
7125   $geocode = $cust_tax_location[0]->geocode
7126     if scalar(@cust_tax_location);
7127
7128   $geocode;
7129 }
7130
7131 =item cust_status
7132
7133 =item status
7134
7135 Returns a status string for this customer, currently:
7136
7137 =over 4
7138
7139 =item prospect - No packages have ever been ordered
7140
7141 =item active - One or more recurring packages is active
7142
7143 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7144
7145 =item suspended - All non-cancelled recurring packages are suspended
7146
7147 =item cancelled - All recurring packages are cancelled
7148
7149 =back
7150
7151 =cut
7152
7153 sub status { shift->cust_status(@_); }
7154
7155 sub cust_status {
7156   my $self = shift;
7157   for my $status (qw( prospect active inactive suspended cancelled )) {
7158     my $method = $status.'_sql';
7159     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7160     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7161     $sth->execute( ($self->custnum) x $numnum )
7162       or die "Error executing 'SELECT $sql': ". $sth->errstr;
7163     return $status if $sth->fetchrow_arrayref->[0];
7164   }
7165 }
7166
7167 =item ucfirst_cust_status
7168
7169 =item ucfirst_status
7170
7171 Returns the status with the first character capitalized.
7172
7173 =cut
7174
7175 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7176
7177 sub ucfirst_cust_status {
7178   my $self = shift;
7179   ucfirst($self->cust_status);
7180 }
7181
7182 =item statuscolor
7183
7184 Returns a hex triplet color string for this customer's status.
7185
7186 =cut
7187
7188 use vars qw(%statuscolor);
7189 tie %statuscolor, 'Tie::IxHash',
7190   'prospect'  => '7e0079', #'000000', #black?  naw, purple
7191   'active'    => '00CC00', #green
7192   'inactive'  => '0000CC', #blue
7193   'suspended' => 'FF9900', #yellow
7194   'cancelled' => 'FF0000', #red
7195 ;
7196
7197 sub statuscolor { shift->cust_statuscolor(@_); }
7198
7199 sub cust_statuscolor {
7200   my $self = shift;
7201   $statuscolor{$self->cust_status};
7202 }
7203
7204 =item tickets
7205
7206 Returns an array of hashes representing the customer's RT tickets.
7207
7208 =cut
7209
7210 sub tickets {
7211   my $self = shift;
7212
7213   my $num = $conf->config('cust_main-max_tickets') || 10;
7214   my @tickets = ();
7215
7216   if ( $conf->config('ticket_system') ) {
7217     unless ( $conf->config('ticket_system-custom_priority_field') ) {
7218
7219       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7220
7221     } else {
7222
7223       foreach my $priority (
7224         $conf->config('ticket_system-custom_priority_field-values'), ''
7225       ) {
7226         last if scalar(@tickets) >= $num;
7227         push @tickets,
7228           @{ FS::TicketSystem->customer_tickets( $self->custnum,
7229                                                  $num - scalar(@tickets),
7230                                                  $priority,
7231                                                )
7232            };
7233       }
7234     }
7235   }
7236   (@tickets);
7237 }
7238
7239 # Return services representing svc_accts in customer support packages
7240 sub support_services {
7241   my $self = shift;
7242   my %packages = map { $_ => 1 } $conf->config('support_packages');
7243
7244   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7245     grep { $_->part_svc->svcdb eq 'svc_acct' }
7246     map { $_->cust_svc }
7247     grep { exists $packages{ $_->pkgpart } }
7248     $self->ncancelled_pkgs;
7249
7250 }
7251
7252 # Return a list of latitude/longitude for one of the services (if any)
7253 sub service_coordinates {
7254   my $self = shift;
7255
7256   my @svc_X =
7257     grep { $_->latitude && $_->longitude }
7258     map { $_->svc_x }
7259     map { $_->cust_svc }
7260     $self->ncancelled_pkgs;
7261
7262   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
7263 }
7264
7265 =back
7266
7267 =head1 CLASS METHODS
7268
7269 =over 4
7270
7271 =item statuses
7272
7273 Class method that returns the list of possible status strings for customers
7274 (see L<the status method|/status>).  For example:
7275
7276   @statuses = FS::cust_main->statuses();
7277
7278 =cut
7279
7280 sub statuses {
7281   #my $self = shift; #could be class...
7282   keys %statuscolor;
7283 }
7284
7285 =item prospect_sql
7286
7287 Returns an SQL expression identifying prospective cust_main records (customers
7288 with no packages ever ordered)
7289
7290 =cut
7291
7292 use vars qw($select_count_pkgs);
7293 $select_count_pkgs =
7294   "SELECT COUNT(*) FROM cust_pkg
7295     WHERE cust_pkg.custnum = cust_main.custnum";
7296
7297 sub select_count_pkgs_sql {
7298   $select_count_pkgs;
7299 }
7300
7301 sub prospect_sql { "
7302   0 = ( $select_count_pkgs )
7303 "; }
7304
7305 =item active_sql
7306
7307 Returns an SQL expression identifying active cust_main records (customers with
7308 active recurring packages).
7309
7310 =cut
7311
7312 sub active_sql { "
7313   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
7314       )
7315 "; }
7316
7317 =item inactive_sql
7318
7319 Returns an SQL expression identifying inactive cust_main records (customers with
7320 no active recurring packages, but otherwise unsuspended/uncancelled).
7321
7322 =cut
7323
7324 sub inactive_sql { "
7325   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7326   AND
7327   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7328 "; }
7329
7330 =item susp_sql
7331 =item suspended_sql
7332
7333 Returns an SQL expression identifying suspended cust_main records.
7334
7335 =cut
7336
7337
7338 sub suspended_sql { susp_sql(@_); }
7339 sub susp_sql { "
7340     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7341     AND
7342     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7343 "; }
7344
7345 =item cancel_sql
7346 =item cancelled_sql
7347
7348 Returns an SQL expression identifying cancelled cust_main records.
7349
7350 =cut
7351
7352 sub cancelled_sql { cancel_sql(@_); }
7353 sub cancel_sql {
7354
7355   my $recurring_sql = FS::cust_pkg->recurring_sql;
7356   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7357
7358   "
7359         0 < ( $select_count_pkgs )
7360     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
7361     AND 0 = ( $select_count_pkgs AND $recurring_sql
7362                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7363             )
7364     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7365   ";
7366
7367 }
7368
7369 =item uncancel_sql
7370 =item uncancelled_sql
7371
7372 Returns an SQL expression identifying un-cancelled cust_main records.
7373
7374 =cut
7375
7376 sub uncancelled_sql { uncancel_sql(@_); }
7377 sub uncancel_sql { "
7378   ( 0 < ( $select_count_pkgs
7379                    AND ( cust_pkg.cancel IS NULL
7380                          OR cust_pkg.cancel = 0
7381                        )
7382         )
7383     OR 0 = ( $select_count_pkgs )
7384   )
7385 "; }
7386
7387 =item balance_sql
7388
7389 Returns an SQL fragment to retreive the balance.
7390
7391 =cut
7392
7393 sub balance_sql { "
7394     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7395         WHERE cust_bill.custnum   = cust_main.custnum     )
7396   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
7397         WHERE cust_pay.custnum    = cust_main.custnum     )
7398   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
7399         WHERE cust_credit.custnum = cust_main.custnum     )
7400   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
7401         WHERE cust_refund.custnum = cust_main.custnum     )
7402 "; }
7403
7404 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7405
7406 Returns an SQL fragment to retreive the balance for this customer, only
7407 considering invoices with date earlier than START_TIME, and optionally not
7408 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7409 total_unapplied_payments).
7410
7411 Times are specified as SQL fragments or numeric
7412 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
7413 L<Date::Parse> for conversion functions.  The empty string can be passed
7414 to disable that time constraint completely.
7415
7416 Available options are:
7417
7418 =over 4
7419
7420 =item unapplied_date
7421
7422 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)
7423
7424 =item total
7425
7426 (unused.  obsolete?)
7427 set to true to remove all customer comparison clauses, for totals
7428
7429 =item where
7430
7431 (unused.  obsolete?)
7432 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7433
7434 =item join
7435
7436 (unused.  obsolete?)
7437 JOIN clause (typically used with the total option)
7438
7439 =item cutoff
7440
7441 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
7442 time will be ignored.  Note that START_TIME and END_TIME only limit the date
7443 range for invoices and I<unapplied> payments, credits, and refunds.
7444
7445 =back
7446
7447 =cut
7448
7449 sub balance_date_sql {
7450   my( $class, $start, $end, %opt ) = @_;
7451
7452   my $cutoff = $opt{'cutoff'};
7453
7454   my $owed         = FS::cust_bill->owed_sql($cutoff);
7455   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
7456   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
7457   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
7458
7459   my $j = $opt{'join'} || '';
7460
7461   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
7462   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7463   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7464   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
7465
7466   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
7467     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7468     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7469     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
7470   ";
7471
7472 }
7473
7474 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
7475
7476 Returns an SQL fragment to retreive the total unapplied payments for this
7477 customer, only considering invoices with date earlier than START_TIME, and
7478 optionally not later than END_TIME.
7479
7480 Times are specified as SQL fragments or numeric
7481 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
7482 L<Date::Parse> for conversion functions.  The empty string can be passed
7483 to disable that time constraint completely.
7484
7485 Available options are:
7486
7487 =cut
7488
7489 sub unapplied_payments_date_sql {
7490   my( $class, $start, $end, ) = @_;
7491
7492   my $unapp_pay    = FS::cust_pay->unapplied_sql;
7493
7494   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
7495                                                           'unapplied_date'=>1 );
7496
7497   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
7498 }
7499
7500 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7501
7502 Helper method for balance_date_sql; name (and usage) subject to change
7503 (suggestions welcome).
7504
7505 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7506 cust_refund, cust_credit or cust_pay).
7507
7508 If TABLE is "cust_bill" or the unapplied_date option is true, only
7509 considers records with date earlier than START_TIME, and optionally not
7510 later than END_TIME .
7511
7512 =cut
7513
7514 sub _money_table_where {
7515   my( $class, $table, $start, $end, %opt ) = @_;
7516
7517   my @where = ();
7518   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7519   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7520     push @where, "$table._date <= $start" if defined($start) && length($start);
7521     push @where, "$table._date >  $end"   if defined($end)   && length($end);
7522   }
7523   push @where, @{$opt{'where'}} if $opt{'where'};
7524   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7525
7526   $where;
7527
7528 }
7529
7530 =item search HASHREF
7531
7532 (Class method)
7533
7534 Returns a qsearch hash expression to search for parameters specified in
7535 HASHREF.  Valid parameters are
7536
7537 =over 4
7538
7539 =item agentnum
7540
7541 =item status
7542
7543 =item cancelled_pkgs
7544
7545 bool
7546
7547 =item signupdate
7548
7549 listref of start date, end date
7550
7551 =item payby
7552
7553 listref
7554
7555 =item paydate_year
7556
7557 =item paydate_month
7558
7559 =item current_balance
7560
7561 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7562
7563 =item cust_fields
7564
7565 =item flattened_pkgs
7566
7567 bool
7568
7569 =back
7570
7571 =cut
7572
7573 sub search {
7574   my ($class, $params) = @_;
7575
7576   my $dbh = dbh;
7577
7578   my @where = ();
7579   my $orderby;
7580
7581   ##
7582   # parse agent
7583   ##
7584
7585   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7586     push @where,
7587       "cust_main.agentnum = $1";
7588   }
7589
7590   ##
7591   # do the same for user
7592   ##
7593
7594   if ( $params->{'usernum'} =~ /^(\d+)$/ and $1 ) {
7595     push @where,
7596       "cust_main.usernum = $1";
7597   }
7598
7599   ##
7600   # parse status
7601   ##
7602
7603   #prospect active inactive suspended cancelled
7604   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7605     my $method = $params->{'status'}. '_sql';
7606     #push @where, $class->$method();
7607     push @where, FS::cust_main->$method();
7608   }
7609
7610   ##
7611   # parse cancelled package checkbox
7612   ##
7613
7614   my $pkgwhere = "";
7615
7616   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7617     unless $params->{'cancelled_pkgs'};
7618
7619   ##
7620   # parse without census tract checkbox
7621   ##
7622
7623   push @where, "(censustract = '' or censustract is null)"
7624     if $params->{'no_censustract'};
7625
7626   ##
7627   # dates
7628   ##
7629
7630   foreach my $field (qw( signupdate )) {
7631
7632     next unless exists($params->{$field});
7633
7634     my($beginning, $ending, $hour) = @{$params->{$field}};
7635
7636     push @where,
7637       "cust_main.$field IS NOT NULL",
7638       "cust_main.$field >= $beginning",
7639       "cust_main.$field <= $ending";
7640
7641     # XXX: do this for mysql and/or pull it out of here
7642     if(defined $hour) {
7643       if ($dbh->{Driver}->{Name} eq 'Pg') {
7644         push @where, "extract(hour from to_timestamp(cust_main.$field)) = $hour";
7645       }
7646       else {
7647         warn "search by time of day not supported on ".$dbh->{Driver}->{Name}." databases";
7648       }
7649     }
7650
7651     $orderby ||= "ORDER BY cust_main.$field";
7652
7653   }
7654
7655   ###
7656   # classnum
7657   ###
7658
7659   if ( $params->{'classnum'} ) {
7660
7661     my @classnum = ref( $params->{'classnum'} )
7662                      ? @{ $params->{'classnum'} }
7663                      :  ( $params->{'classnum'} );
7664
7665     @classnum = grep /^(\d*)$/, @classnum;
7666
7667     if ( @classnum ) {
7668       push @where, '( '. join(' OR ', map {
7669                                             $_ ? "cust_main.classnum = $_"
7670                                                : "cust_main.classnum IS NULL"
7671                                           }
7672                                           @classnum
7673                              ).
7674                    ' )';
7675     }
7676
7677   }
7678
7679   ###
7680   # payby
7681   ###
7682
7683   if ( $params->{'payby'} ) {
7684
7685     my @payby = ref( $params->{'payby'} )
7686                   ? @{ $params->{'payby'} }
7687                   :  ( $params->{'payby'} );
7688
7689     @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
7690
7691     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )'
7692       if @payby;
7693
7694   }
7695
7696   ###
7697   # paydate_year / paydate_month
7698   ###
7699
7700   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
7701     my $year = $1;
7702     $params->{'paydate_month'} =~ /^(\d\d?)$/
7703       or die "paydate_year without paydate_month?";
7704     my $month = $1;
7705
7706     push @where,
7707       'paydate IS NOT NULL',
7708       "paydate != ''",
7709       "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
7710 ;
7711   }
7712
7713   ###
7714   # invoice terms
7715   ###
7716
7717   if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
7718     my $terms = $1;
7719     if ( $1 eq 'NULL' ) {
7720       push @where,
7721         "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
7722     } else {
7723       push @where,
7724         "cust_main.invoice_terms IS NOT NULL",
7725         "cust_main.invoice_terms = '$1'";
7726     }
7727   }
7728
7729   ##
7730   # amounts
7731   ##
7732
7733   if ( $params->{'current_balance'} ) {
7734
7735     #my $balance_sql = $class->balance_sql();
7736     my $balance_sql = FS::cust_main->balance_sql();
7737
7738     my @current_balance =
7739       ref( $params->{'current_balance'} )
7740       ? @{ $params->{'current_balance'} }
7741       :  ( $params->{'current_balance'} );
7742
7743     push @where, map { s/current_balance/$balance_sql/; $_ }
7744                      @current_balance;
7745
7746   }
7747
7748   ##
7749   # custbatch
7750   ##
7751
7752   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
7753     push @where,
7754       "cust_main.custbatch = '$1'";
7755   }
7756
7757   ##
7758   # setup queries, subs, etc. for the search
7759   ##
7760
7761   $orderby ||= 'ORDER BY custnum';
7762
7763   # here is the agent virtualization
7764   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
7765
7766   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
7767
7768   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
7769
7770   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
7771
7772   my $select = join(', ',
7773                  'cust_main.custnum',
7774                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
7775                );
7776
7777   my(@extra_headers) = ();
7778   my(@extra_fields)  = ();
7779
7780   if ($params->{'flattened_pkgs'}) {
7781
7782     if ($dbh->{Driver}->{Name} eq 'Pg') {
7783
7784       $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";
7785
7786     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
7787       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
7788       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
7789     }else{
7790       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
7791            "omitting packing information from report.";
7792     }
7793
7794     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";
7795
7796     my $sth = dbh->prepare($header_query) or die dbh->errstr;
7797     $sth->execute() or die $sth->errstr;
7798     my $headerrow = $sth->fetchrow_arrayref;
7799     my $headercount = $headerrow ? $headerrow->[0] : 0;
7800     while($headercount) {
7801       unshift @extra_headers, "Package ". $headercount;
7802       unshift @extra_fields, eval q!sub {my $c = shift;
7803                                          my @a = split '\|', $c->magic;
7804                                          my $p = $a[!.--$headercount. q!];
7805                                          $p;
7806                                         };!;
7807     }
7808
7809   }
7810
7811   my $sql_query = {
7812     'table'         => 'cust_main',
7813     'select'        => $select,
7814     'hashref'       => {},
7815     'extra_sql'     => $extra_sql,
7816     'order_by'      => $orderby,
7817     'count_query'   => $count_query,
7818     'extra_headers' => \@extra_headers,
7819     'extra_fields'  => \@extra_fields,
7820   };
7821
7822 }
7823
7824 =item email_search_result HASHREF
7825
7826 (Class method)
7827
7828 Emails a notice to the specified customers.
7829
7830 Valid parameters are those of the L<search> method, plus the following:
7831
7832 =over 4
7833
7834 =item from
7835
7836 From: address
7837
7838 =item subject
7839
7840 Email Subject:
7841
7842 =item html_body
7843
7844 HTML body
7845
7846 =item text_body
7847
7848 Text body
7849
7850 =item job
7851
7852 Optional job queue job for status updates.
7853
7854 =back
7855
7856 Returns an error message, or false for success.
7857
7858 If an error occurs during any email, stops the enture send and returns that
7859 error.  Presumably if you're getting SMTP errors aborting is better than
7860 retrying everything.
7861
7862 =cut
7863
7864 sub email_search_result {
7865   my($class, $params) = @_;
7866
7867   my $from = delete $params->{from};
7868   my $subject = delete $params->{subject};
7869   my $html_body = delete $params->{html_body};
7870   my $text_body = delete $params->{text_body};
7871
7872   my $job = delete $params->{'job'};
7873
7874   $params->{'payby'} = [ split(/\0/, $params->{'payby'}) ]
7875     unless ref($params->{'payby'});
7876
7877   my $sql_query = $class->search($params);
7878
7879   my $count_query   = delete($sql_query->{'count_query'});
7880   my $count_sth = dbh->prepare($count_query)
7881     or die "Error preparing $count_query: ". dbh->errstr;
7882   $count_sth->execute
7883     or die "Error executing $count_query: ". $count_sth->errstr;
7884   my $count_arrayref = $count_sth->fetchrow_arrayref;
7885   my $num_cust = $count_arrayref->[0];
7886
7887   #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
7888   #my @extra_fields  = @{ delete($sql_query->{'extra_fields'})  };
7889
7890
7891   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
7892
7893   #eventually order+limit magic to reduce memory use?
7894   foreach my $cust_main ( qsearch($sql_query) ) {
7895
7896     my $to = $cust_main->invoicing_list_emailonly_scalar;
7897     next unless $to;
7898
7899     my $error = send_email(
7900       generate_email(
7901         'from'      => $from,
7902         'to'        => $to,
7903         'subject'   => $subject,
7904         'html_body' => $html_body,
7905         'text_body' => $text_body,
7906       )
7907     );
7908     return $error if $error;
7909
7910     if ( $job ) { #progressbar foo
7911       $num++;
7912       if ( time - $min_sec > $last ) {
7913         my $error = $job->update_statustext(
7914           int( 100 * $num / $num_cust )
7915         );
7916         die $error if $error;
7917         $last = time;
7918       }
7919     }
7920
7921   }
7922
7923   return '';
7924 }
7925
7926 use Storable qw(thaw);
7927 use Data::Dumper;
7928 use MIME::Base64;
7929 sub process_email_search_result {
7930   my $job = shift;
7931   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
7932
7933   my $param = thaw(decode_base64(shift));
7934   warn Dumper($param) if $DEBUG;
7935
7936   $param->{'job'} = $job;
7937
7938   $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
7939     unless ref($param->{'payby'});
7940
7941   my $error = FS::cust_main->email_search_result( $param );
7942   die $error if $error;
7943
7944 }
7945
7946 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
7947
7948 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
7949 records.  Currently, I<first>, I<last>, I<company> and/or I<address1> may be
7950 specified (the appropriate ship_ field is also searched).
7951
7952 Additional options are the same as FS::Record::qsearch
7953
7954 =cut
7955
7956 sub fuzzy_search {
7957   my( $self, $fuzzy, $hash, @opt) = @_;
7958   #$self
7959   $hash ||= {};
7960   my @cust_main = ();
7961
7962   check_and_rebuild_fuzzyfiles();
7963   foreach my $field ( keys %$fuzzy ) {
7964
7965     my $all = $self->all_X($field);
7966     next unless scalar(@$all);
7967
7968     my %match = ();
7969     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
7970
7971     my @fcust = ();
7972     foreach ( keys %match ) {
7973       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
7974       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
7975     }
7976     my %fsaw = ();
7977     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
7978   }
7979
7980   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
7981   my %saw = ();
7982   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
7983
7984   @cust_main;
7985
7986 }
7987
7988 =item masked FIELD
7989
7990 Returns a masked version of the named field
7991
7992 =cut
7993
7994 sub masked {
7995 my ($self,$field) = @_;
7996
7997 # Show last four
7998
7999 'x'x(length($self->getfield($field))-4).
8000   substr($self->getfield($field), (length($self->getfield($field))-4));
8001
8002 }
8003
8004 =back
8005
8006 =head1 SUBROUTINES
8007
8008 =over 4
8009
8010 =item smart_search OPTION => VALUE ...
8011
8012 Accepts the following options: I<search>, the string to search for.  The string
8013 will be searched for as a customer number, phone number, name or company name,
8014 as an exact, or, in some cases, a substring or fuzzy match (see the source code
8015 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
8016 skip fuzzy matching when an exact match is found.
8017
8018 Any additional options are treated as an additional qualifier on the search
8019 (i.e. I<agentnum>).
8020
8021 Returns a (possibly empty) array of FS::cust_main objects.
8022
8023 =cut
8024
8025 sub smart_search {
8026   my %options = @_;
8027
8028   #here is the agent virtualization
8029   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8030
8031   my @cust_main = ();
8032
8033   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
8034   my $search = delete $options{'search'};
8035   ( my $alphanum_search = $search ) =~ s/\W//g;
8036
8037   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
8038
8039     #false laziness w/Record::ut_phone
8040     my $phonen = "$1-$2-$3";
8041     $phonen .= " x$4" if $4;
8042
8043     push @cust_main, qsearch( {
8044       'table'   => 'cust_main',
8045       'hashref' => { %options },
8046       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8047                      ' ( '.
8048                          join(' OR ', map "$_ = '$phonen'",
8049                                           qw( daytime night fax
8050                                               ship_daytime ship_night ship_fax )
8051                              ).
8052                      ' ) '.
8053                      " AND $agentnums_sql", #agent virtualization
8054     } );
8055
8056     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
8057       #try looking for matches with extensions unless one was specified
8058
8059       push @cust_main, qsearch( {
8060         'table'   => 'cust_main',
8061         'hashref' => { %options },
8062         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8063                        ' ( '.
8064                            join(' OR ', map "$_ LIKE '$phonen\%'",
8065                                             qw( daytime night
8066                                                 ship_daytime ship_night )
8067                                ).
8068                        ' ) '.
8069                        " AND $agentnums_sql", #agent virtualization
8070       } );
8071
8072     }
8073
8074   # custnum search (also try agent_custid), with some tweaking options if your
8075   # legacy cust "numbers" have letters
8076   }
8077
8078   if ( $search =~ /^\s*(\d+)\s*$/
8079          || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
8080               && $search =~ /^\s*(\w\w?\d+)\s*$/
8081             )
8082          || ( $conf->exists('address1-search' )
8083               && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
8084             )
8085      )
8086   {
8087
8088     my $num = $1;
8089
8090     if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
8091       push @cust_main, qsearch( {
8092         'table'     => 'cust_main',
8093         'hashref'   => { 'custnum' => $num, %options },
8094         'extra_sql' => " AND $agentnums_sql", #agent virtualization
8095       } );
8096     }
8097
8098     push @cust_main, qsearch( {
8099       'table'     => 'cust_main',
8100       'hashref'   => { 'agent_custid' => $num, %options },
8101       'extra_sql' => " AND $agentnums_sql", #agent virtualization
8102     } );
8103
8104     if ( $conf->exists('address1-search') ) {
8105       my $len = length($num);
8106       $num = lc($num);
8107       foreach my $prefix ( '', 'ship_' ) {
8108         push @cust_main, qsearch( {
8109           'table'     => 'cust_main',
8110           'hashref'   => { %options, },
8111           'extra_sql' =>
8112             ( keys(%options) ? ' AND ' : ' WHERE ' ).
8113             " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ".
8114             " AND $agentnums_sql",
8115         } );
8116       }
8117     }
8118
8119   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
8120
8121     my($company, $last, $first) = ( $1, $2, $3 );
8122
8123     # "Company (Last, First)"
8124     #this is probably something a browser remembered,
8125     #so just do an exact search (but case-insensitive, so USPS standardization
8126     #doesn't throw a wrench in the works)
8127
8128     foreach my $prefix ( '', 'ship_' ) {
8129       push @cust_main, qsearch( {
8130         'table'     => 'cust_main',
8131         'hashref'   => { %options },
8132         'extra_sql' =>
8133           ( keys(%options) ? ' AND ' : ' WHERE ' ).
8134           join(' AND ',
8135             " LOWER(${prefix}first)   = ". dbh->quote(lc($first)),
8136             " LOWER(${prefix}last)    = ". dbh->quote(lc($last)),
8137             " LOWER(${prefix}company) = ". dbh->quote(lc($company)),
8138             $agentnums_sql,
8139           ),
8140       } );
8141     }
8142
8143   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
8144                                               # try (ship_){last,company}
8145
8146     my $value = lc($1);
8147
8148     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
8149     # # full strings the browser remembers won't work
8150     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
8151
8152     use Lingua::EN::NameParse;
8153     my $NameParse = new Lingua::EN::NameParse(
8154              auto_clean     => 1,
8155              allow_reversed => 1,
8156     );
8157
8158     my($last, $first) = ( '', '' );
8159     #maybe disable this too and just rely on NameParse?
8160     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
8161
8162       ($last, $first) = ( $1, $2 );
8163
8164     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
8165     } elsif ( ! $NameParse->parse($value) ) {
8166
8167       my %name = $NameParse->components;
8168       $first = $name{'given_name_1'};
8169       $last  = $name{'surname_1'};
8170
8171     }
8172
8173     if ( $first && $last ) {
8174
8175       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
8176
8177       #exact
8178       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8179       $sql .= "
8180         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
8181            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
8182         )";
8183
8184       push @cust_main, qsearch( {
8185         'table'     => 'cust_main',
8186         'hashref'   => \%options,
8187         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8188       } );
8189
8190       # or it just be something that was typed in... (try that in a sec)
8191
8192     }
8193
8194     my $q_value = dbh->quote($value);
8195
8196     #exact
8197     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8198     $sql .= " (    LOWER(last)          = $q_value
8199                 OR LOWER(company)       = $q_value
8200                 OR LOWER(ship_last)     = $q_value
8201                 OR LOWER(ship_company)  = $q_value
8202             ";
8203     $sql .= "   OR LOWER(address1)      = $q_value
8204                 OR LOWER(ship_address1) = $q_value
8205             "
8206       if $conf->exists('address1-search');
8207     $sql .= " )";
8208
8209     push @cust_main, qsearch( {
8210       'table'     => 'cust_main',
8211       'hashref'   => \%options,
8212       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8213     } );
8214
8215     #no exact match, trying substring/fuzzy
8216     #always do substring & fuzzy (unless they're explicity config'ed off)
8217     #getting complaints searches are not returning enough
8218     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8219
8220       #still some false laziness w/search (was search/cust_main.cgi)
8221
8222       #substring
8223
8224       my @hashrefs = (
8225         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
8226         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
8227       );
8228
8229       if ( $first && $last ) {
8230
8231         push @hashrefs,
8232           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
8233             'last'         => { op=>'ILIKE', value=>"%$last%" },
8234           },
8235           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
8236             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
8237           },
8238         ;
8239
8240       } else {
8241
8242         push @hashrefs,
8243           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
8244           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
8245         ;
8246       }
8247
8248       if ( $conf->exists('address1-search') ) {
8249         push @hashrefs,
8250           { 'address1'      => { op=>'ILIKE', value=>"%$value%" }, },
8251           { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, },
8252         ;
8253       }
8254
8255       foreach my $hashref ( @hashrefs ) {
8256
8257         push @cust_main, qsearch( {
8258           'table'     => 'cust_main',
8259           'hashref'   => { %$hashref,
8260                            %options,
8261                          },
8262           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
8263         } );
8264
8265       }
8266
8267       #fuzzy
8268       my @fuzopts = (
8269         \%options,                #hashref
8270         '',                       #select
8271         " AND $agentnums_sql",    #extra_sql  #agent virtualization
8272       );
8273
8274       if ( $first && $last ) {
8275         push @cust_main, FS::cust_main->fuzzy_search(
8276           { 'last'   => $last,    #fuzzy hashref
8277             'first'  => $first }, #
8278           @fuzopts
8279         );
8280       }
8281       foreach my $field ( 'last', 'company' ) {
8282         push @cust_main,
8283           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
8284       }
8285       if ( $conf->exists('address1-search') ) {
8286         push @cust_main,
8287           FS::cust_main->fuzzy_search( { 'address1' => $value }, @fuzopts );
8288       }
8289
8290     }
8291
8292   }
8293
8294   #eliminate duplicates
8295   my %saw = ();
8296   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8297
8298   @cust_main;
8299
8300 }
8301
8302 =item email_search
8303
8304 Accepts the following options: I<email>, the email address to search for.  The
8305 email address will be searched for as an email invoice destination and as an
8306 svc_acct account.
8307
8308 #Any additional options are treated as an additional qualifier on the search
8309 #(i.e. I<agentnum>).
8310
8311 Returns a (possibly empty) array of FS::cust_main objects (but usually just
8312 none or one).
8313
8314 =cut
8315
8316 sub email_search {
8317   my %options = @_;
8318
8319   local($DEBUG) = 1;
8320
8321   my $email = delete $options{'email'};
8322
8323   #we're only being used by RT at the moment... no agent virtualization yet
8324   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8325
8326   my @cust_main = ();
8327
8328   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
8329
8330     my ( $user, $domain ) = ( $1, $2 );
8331
8332     warn "$me smart_search: searching for $user in domain $domain"
8333       if $DEBUG;
8334
8335     push @cust_main,
8336       map $_->cust_main,
8337           qsearch( {
8338                      'table'     => 'cust_main_invoice',
8339                      'hashref'   => { 'dest' => $email },
8340                    }
8341                  );
8342
8343     push @cust_main,
8344       map  $_->cust_main,
8345       grep $_,
8346       map  $_->cust_svc->cust_pkg,
8347           qsearch( {
8348                      'table'     => 'svc_acct',
8349                      'hashref'   => { 'username' => $user, },
8350                      'extra_sql' =>
8351                        'AND ( SELECT domain FROM svc_domain
8352                                 WHERE svc_acct.domsvc = svc_domain.svcnum
8353                             ) = '. dbh->quote($domain),
8354                    }
8355                  );
8356   }
8357
8358   my %saw = ();
8359   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8360
8361   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8362     if $DEBUG;
8363
8364   @cust_main;
8365
8366 }
8367
8368 =item check_and_rebuild_fuzzyfiles
8369
8370 =cut
8371
8372 sub check_and_rebuild_fuzzyfiles {
8373   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8374   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8375 }
8376
8377 =item rebuild_fuzzyfiles
8378
8379 =cut
8380
8381 sub rebuild_fuzzyfiles {
8382
8383   use Fcntl qw(:flock);
8384
8385   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8386   mkdir $dir, 0700 unless -d $dir;
8387
8388   foreach my $fuzzy ( @fuzzyfields ) {
8389
8390     open(LOCK,">>$dir/cust_main.$fuzzy")
8391       or die "can't open $dir/cust_main.$fuzzy: $!";
8392     flock(LOCK,LOCK_EX)
8393       or die "can't lock $dir/cust_main.$fuzzy: $!";
8394
8395     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8396       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8397
8398     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8399       my $sth = dbh->prepare("SELECT $field FROM cust_main".
8400                              " WHERE $field != '' AND $field IS NOT NULL");
8401       $sth->execute or die $sth->errstr;
8402
8403       while ( my $row = $sth->fetchrow_arrayref ) {
8404         print CACHE $row->[0]. "\n";
8405       }
8406
8407     }
8408
8409     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8410
8411     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8412     close LOCK;
8413   }
8414
8415 }
8416
8417 =item all_X
8418
8419 =cut
8420
8421 sub all_X {
8422   my( $self, $field ) = @_;
8423   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8424   open(CACHE,"<$dir/cust_main.$field")
8425     or die "can't open $dir/cust_main.$field: $!";
8426   my @array = map { chomp; $_; } <CACHE>;
8427   close CACHE;
8428   \@array;
8429 }
8430
8431 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
8432
8433 =cut
8434
8435 sub append_fuzzyfiles {
8436   #my( $first, $last, $company ) = @_;
8437
8438   &check_and_rebuild_fuzzyfiles;
8439
8440   use Fcntl qw(:flock);
8441
8442   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8443
8444   foreach my $field (@fuzzyfields) {
8445     my $value = shift;
8446
8447     if ( $value ) {
8448
8449       open(CACHE,">>$dir/cust_main.$field")
8450         or die "can't open $dir/cust_main.$field: $!";
8451       flock(CACHE,LOCK_EX)
8452         or die "can't lock $dir/cust_main.$field: $!";
8453
8454       print CACHE "$value\n";
8455
8456       flock(CACHE,LOCK_UN)
8457         or die "can't unlock $dir/cust_main.$field: $!";
8458       close CACHE;
8459     }
8460
8461   }
8462
8463   1;
8464 }
8465
8466 =item batch_charge
8467
8468 =cut
8469
8470 sub batch_charge {
8471   my $param = shift;
8472   #warn join('-',keys %$param);
8473   my $fh = $param->{filehandle};
8474   my @fields = @{$param->{fields}};
8475
8476   eval "use Text::CSV_XS;";
8477   die $@ if $@;
8478
8479   my $csv = new Text::CSV_XS;
8480   #warn $csv;
8481   #warn $fh;
8482
8483   my $imported = 0;
8484   #my $columns;
8485
8486   local $SIG{HUP} = 'IGNORE';
8487   local $SIG{INT} = 'IGNORE';
8488   local $SIG{QUIT} = 'IGNORE';
8489   local $SIG{TERM} = 'IGNORE';
8490   local $SIG{TSTP} = 'IGNORE';
8491   local $SIG{PIPE} = 'IGNORE';
8492
8493   my $oldAutoCommit = $FS::UID::AutoCommit;
8494   local $FS::UID::AutoCommit = 0;
8495   my $dbh = dbh;
8496
8497   #while ( $columns = $csv->getline($fh) ) {
8498   my $line;
8499   while ( defined($line=<$fh>) ) {
8500
8501     $csv->parse($line) or do {
8502       $dbh->rollback if $oldAutoCommit;
8503       return "can't parse: ". $csv->error_input();
8504     };
8505
8506     my @columns = $csv->fields();
8507     #warn join('-',@columns);
8508
8509     my %row = ();
8510     foreach my $field ( @fields ) {
8511       $row{$field} = shift @columns;
8512     }
8513
8514     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
8515     unless ( $cust_main ) {
8516       $dbh->rollback if $oldAutoCommit;
8517       return "unknown custnum $row{'custnum'}";
8518     }
8519
8520     if ( $row{'amount'} > 0 ) {
8521       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
8522       if ( $error ) {
8523         $dbh->rollback if $oldAutoCommit;
8524         return $error;
8525       }
8526       $imported++;
8527     } elsif ( $row{'amount'} < 0 ) {
8528       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
8529                                       $row{'pkg'}                         );
8530       if ( $error ) {
8531         $dbh->rollback if $oldAutoCommit;
8532         return $error;
8533       }
8534       $imported++;
8535     } else {
8536       #hmm?
8537     }
8538
8539   }
8540
8541   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
8542
8543   return "Empty file!" unless $imported;
8544
8545   ''; #no error
8546
8547 }
8548
8549 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8550
8551 Sends a templated email notification to the customer (see L<Text::Template>).
8552
8553 OPTIONS is a hash and may include
8554
8555 I<from> - the email sender (default is invoice_from)
8556
8557 I<to> - comma-separated scalar or arrayref of recipients
8558    (default is invoicing_list)
8559
8560 I<subject> - The subject line of the sent email notification
8561    (default is "Notice from company_name")
8562
8563 I<extra_fields> - a hashref of name/value pairs which will be substituted
8564    into the template
8565
8566 The following variables are vavailable in the template.
8567
8568 I<$first> - the customer first name
8569 I<$last> - the customer last name
8570 I<$company> - the customer company
8571 I<$payby> - a description of the method of payment for the customer
8572             # would be nice to use FS::payby::shortname
8573 I<$payinfo> - the account information used to collect for this customer
8574 I<$expdate> - the expiration of the customer payment in seconds from epoch
8575
8576 =cut
8577
8578 sub notify {
8579   my ($self, $template, %options) = @_;
8580
8581   return unless $conf->exists($template);
8582
8583   my $from = $conf->config('invoice_from', $self->agentnum)
8584     if $conf->exists('invoice_from', $self->agentnum);
8585   $from = $options{from} if exists($options{from});
8586
8587   my $to = join(',', $self->invoicing_list_emailonly);
8588   $to = $options{to} if exists($options{to});
8589
8590   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8591     if $conf->exists('company_name', $self->agentnum);
8592   $subject = $options{subject} if exists($options{subject});
8593
8594   my $notify_template = new Text::Template (TYPE => 'ARRAY',
8595                                             SOURCE => [ map "$_\n",
8596                                               $conf->config($template)]
8597                                            )
8598     or die "can't create new Text::Template object: Text::Template::ERROR";
8599   $notify_template->compile()
8600     or die "can't compile template: Text::Template::ERROR";
8601
8602   $FS::notify_template::_template::company_name =
8603     $conf->config('company_name', $self->agentnum);
8604   $FS::notify_template::_template::company_address =
8605     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
8606
8607   my $paydate = $self->paydate || '2037-12-31';
8608   $FS::notify_template::_template::first = $self->first;
8609   $FS::notify_template::_template::last = $self->last;
8610   $FS::notify_template::_template::company = $self->company;
8611   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
8612   my $payby = $self->payby;
8613   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8614   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8615
8616   #credit cards expire at the end of the month/year of their exp date
8617   if ($payby eq 'CARD' || $payby eq 'DCRD') {
8618     $FS::notify_template::_template::payby = 'credit card';
8619     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8620     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8621     $expire_time--;
8622   }elsif ($payby eq 'COMP') {
8623     $FS::notify_template::_template::payby = 'complimentary account';
8624   }else{
8625     $FS::notify_template::_template::payby = 'current method';
8626   }
8627   $FS::notify_template::_template::expdate = $expire_time;
8628
8629   for (keys %{$options{extra_fields}}){
8630     no strict "refs";
8631     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
8632   }
8633
8634   send_email(from => $from,
8635              to => $to,
8636              subject => $subject,
8637              body => $notify_template->fill_in( PACKAGE =>
8638                                                 'FS::notify_template::_template'                                              ),
8639             );
8640
8641 }
8642
8643 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8644
8645 Generates a templated notification to the customer (see L<Text::Template>).
8646
8647 OPTIONS is a hash and may include
8648
8649 I<extra_fields> - a hashref of name/value pairs which will be substituted
8650    into the template.  These values may override values mentioned below
8651    and those from the customer record.
8652
8653 The following variables are available in the template instead of or in addition
8654 to the fields of the customer record.
8655
8656 I<$payby> - a description of the method of payment for the customer
8657             # would be nice to use FS::payby::shortname
8658 I<$payinfo> - the masked account information used to collect for this customer
8659 I<$expdate> - the expiration of the customer payment method in seconds from epoch
8660 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
8661
8662 =cut
8663
8664 sub generate_letter {
8665   my ($self, $template, %options) = @_;
8666
8667   return unless $conf->exists($template);
8668
8669   my $letter_template = new Text::Template
8670                         ( TYPE       => 'ARRAY',
8671                           SOURCE     => [ map "$_\n", $conf->config($template)],
8672                           DELIMITERS => [ '[@--', '--@]' ],
8673                         )
8674     or die "can't create new Text::Template object: Text::Template::ERROR";
8675
8676   $letter_template->compile()
8677     or die "can't compile template: Text::Template::ERROR";
8678
8679   my %letter_data = map { $_ => $self->$_ } $self->fields;
8680   $letter_data{payinfo} = $self->mask_payinfo;
8681
8682   #my $paydate = $self->paydate || '2037-12-31';
8683   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
8684
8685   my $payby = $self->payby;
8686   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8687   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8688
8689   #credit cards expire at the end of the month/year of their exp date
8690   if ($payby eq 'CARD' || $payby eq 'DCRD') {
8691     $letter_data{payby} = 'credit card';
8692     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8693     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8694     $expire_time--;
8695   }elsif ($payby eq 'COMP') {
8696     $letter_data{payby} = 'complimentary account';
8697   }else{
8698     $letter_data{payby} = 'current method';
8699   }
8700   $letter_data{expdate} = $expire_time;
8701
8702   for (keys %{$options{extra_fields}}){
8703     $letter_data{$_} = $options{extra_fields}->{$_};
8704   }
8705
8706   unless(exists($letter_data{returnaddress})){
8707     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
8708                                                   $self->agent_template)
8709                      );
8710     if ( length($retadd) ) {
8711       $letter_data{returnaddress} = $retadd;
8712     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
8713       $letter_data{returnaddress} =
8714         join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
8715                           $conf->config('company_address', $self->agentnum)
8716         );
8717     } else {
8718       $letter_data{returnaddress} = '~';
8719     }
8720   }
8721
8722   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
8723
8724   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
8725
8726   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
8727   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
8728                            DIR      => $dir,
8729                            SUFFIX   => '.tex',
8730                            UNLINK   => 0,
8731                          ) or die "can't open temp file: $!\n";
8732
8733   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
8734   close $fh;
8735   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
8736   return $1;
8737 }
8738
8739 =item print_ps TEMPLATE
8740
8741 Returns an postscript letter filled in from TEMPLATE, as a scalar.
8742
8743 =cut
8744
8745 sub print_ps {
8746   my $self = shift;
8747   my $file = $self->generate_letter(@_);
8748   FS::Misc::generate_ps($file);
8749 }
8750
8751 =item print TEMPLATE
8752
8753 Prints the filled in template.
8754
8755 TEMPLATE is the name of a L<Text::Template> to fill in and print.
8756
8757 =cut
8758
8759 sub queueable_print {
8760   my %opt = @_;
8761
8762   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
8763     or die "invalid customer number: " . $opt{custvnum};
8764
8765   my $error = $self->print( $opt{template} );
8766   die $error if $error;
8767 }
8768
8769 sub print {
8770   my ($self, $template) = (shift, shift);
8771   do_print [ $self->print_ps($template) ];
8772 }
8773
8774 #these three subs should just go away once agent stuff is all config overrides
8775
8776 sub agent_template {
8777   my $self = shift;
8778   $self->_agent_plandata('agent_templatename');
8779 }
8780
8781 sub agent_invoice_from {
8782   my $self = shift;
8783   $self->_agent_plandata('agent_invoice_from');
8784 }
8785
8786 sub _agent_plandata {
8787   my( $self, $option ) = @_;
8788
8789   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
8790   #agent-specific Conf
8791
8792   use FS::part_event::Condition;
8793
8794   my $agentnum = $self->agentnum;
8795
8796   my $regexp = regexp_sql();
8797
8798   my $part_event_option =
8799     qsearchs({
8800       'select'    => 'part_event_option.*',
8801       'table'     => 'part_event_option',
8802       'addl_from' => q{
8803         LEFT JOIN part_event USING ( eventpart )
8804         LEFT JOIN part_event_option AS peo_agentnum
8805           ON ( part_event.eventpart = peo_agentnum.eventpart
8806                AND peo_agentnum.optionname = 'agentnum'
8807                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
8808              )
8809         LEFT JOIN part_event_condition
8810           ON ( part_event.eventpart = part_event_condition.eventpart
8811                AND part_event_condition.conditionname = 'cust_bill_age'
8812              )
8813         LEFT JOIN part_event_condition_option
8814           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
8815                AND part_event_condition_option.optionname = 'age'
8816              )
8817       },
8818       #'hashref'   => { 'optionname' => $option },
8819       #'hashref'   => { 'part_event_option.optionname' => $option },
8820       'extra_sql' =>
8821         " WHERE part_event_option.optionname = ". dbh->quote($option).
8822         " AND action = 'cust_bill_send_agent' ".
8823         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
8824         " AND peo_agentnum.optionname = 'agentnum' ".
8825         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
8826         " ORDER BY
8827            CASE WHEN part_event_condition_option.optionname IS NULL
8828            THEN -1
8829            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
8830         " END
8831           , part_event.weight".
8832         " LIMIT 1"
8833     });
8834
8835   unless ( $part_event_option ) {
8836     return $self->agent->invoice_template || ''
8837       if $option eq 'agent_templatename';
8838     return '';
8839   }
8840
8841   $part_event_option->optionvalue;
8842
8843 }
8844
8845 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
8846
8847 Subroutine (not a method), designed to be called from the queue.
8848
8849 Takes a list of options and values.
8850
8851 Pulls up the customer record via the custnum option and calls bill_and_collect.
8852
8853 =cut
8854
8855 sub queued_bill {
8856   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
8857
8858   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
8859   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
8860
8861   $cust_main->bill_and_collect( %args );
8862 }
8863
8864 sub _upgrade_data { #class method
8865   my ($class, %opts) = @_;
8866
8867   my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
8868   my $sth = dbh->prepare($sql) or die dbh->errstr;
8869   $sth->execute or die $sth->errstr;
8870
8871   local($ignore_expired_card) = 1;
8872   $class->_upgrade_otaker(%opts);
8873
8874 }
8875
8876 =back
8877
8878 =head1 BUGS
8879
8880 The delete method.
8881
8882 The delete method should possibly take an FS::cust_main object reference
8883 instead of a scalar customer number.
8884
8885 Bill and collect options should probably be passed as references instead of a
8886 list.
8887
8888 There should probably be a configuration file with a list of allowed credit
8889 card types.
8890
8891 No multiple currency support (probably a larger project than just this module).
8892
8893 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
8894
8895 Birthdates rely on negative epoch values.
8896
8897 The payby for card/check batches is broken.  With mixed batching, bad
8898 things will happen.
8899
8900 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
8901
8902 =head1 SEE ALSO
8903
8904 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
8905 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
8906 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
8907
8908 =cut
8909
8910 1;
8911