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