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 #  my $sth = dbh->prepare($sql) or die dbh->errstr;
5885 #  $sth->execute() or die $sth->errstr;
5886 #
5887 #  return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] );
5888
5889   my $total_bill = 0;
5890   foreach my $cust_bill (
5891     grep { $_->_date <= $time }
5892       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
5893   ) {
5894     $total_bill += $cust_bill->owed;
5895   }
5896   sprintf( "%.2f", $total_bill );
5897
5898 }
5899
5900 =item total_owed_pkgnum PKGNUM
5901
5902 Returns the total owed on all invoices for this customer's specific package
5903 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
5904
5905 =cut
5906
5907 sub total_owed_pkgnum {
5908   my( $self, $pkgnum ) = @_;
5909   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
5910 }
5911
5912 =item total_owed_date_pkgnum TIME PKGNUM
5913
5914 Returns the total owed for this customer's specific package when using
5915 experimental package balances on all invoices with date earlier than
5916 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
5917 see L<Time::Local> and L<Date::Parse> for conversion functions.
5918
5919 =cut
5920
5921 sub total_owed_date_pkgnum {
5922   my( $self, $time, $pkgnum ) = @_;
5923
5924   my $total_bill = 0;
5925   foreach my $cust_bill (
5926     grep { $_->_date <= $time }
5927       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
5928   ) {
5929     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
5930   }
5931   sprintf( "%.2f", $total_bill );
5932
5933 }
5934
5935 =item total_paid
5936
5937 Returns the total amount of all payments.
5938
5939 =cut
5940
5941 sub total_paid {
5942   my $self = shift;
5943   my $total = 0;
5944   $total += $_->paid foreach $self->cust_pay;
5945   sprintf( "%.2f", $total );
5946 }
5947
5948 =item total_unapplied_credits
5949
5950 Returns the total outstanding credit (see L<FS::cust_credit>) for this
5951 customer.  See L<FS::cust_credit/credited>.
5952
5953 =item total_credited
5954
5955 Old name for total_unapplied_credits.  Don't use.
5956
5957 =cut
5958
5959 sub total_credited {
5960   #carp "total_credited deprecated, use total_unapplied_credits";
5961   shift->total_unapplied_credits(@_);
5962 }
5963
5964 sub total_unapplied_credits {
5965   my $self = shift;
5966   my $total_credit = 0;
5967   $total_credit += $_->credited foreach $self->cust_credit;
5968   sprintf( "%.2f", $total_credit );
5969 }
5970
5971 =item total_unapplied_credits_pkgnum PKGNUM
5972
5973 Returns the total outstanding credit (see L<FS::cust_credit>) for this
5974 customer.  See L<FS::cust_credit/credited>.
5975
5976 =cut
5977
5978 sub total_unapplied_credits_pkgnum {
5979   my( $self, $pkgnum ) = @_;
5980   my $total_credit = 0;
5981   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
5982   sprintf( "%.2f", $total_credit );
5983 }
5984
5985
5986 =item total_unapplied_payments
5987
5988 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
5989 See L<FS::cust_pay/unapplied>.
5990
5991 =cut
5992
5993 sub total_unapplied_payments {
5994   my $self = shift;
5995   my $total_unapplied = 0;
5996   $total_unapplied += $_->unapplied foreach $self->cust_pay;
5997   sprintf( "%.2f", $total_unapplied );
5998 }
5999
6000 =item total_unapplied_payments_pkgnum PKGNUM
6001
6002 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
6003 specific package when using experimental package balances.  See
6004 L<FS::cust_pay/unapplied>.
6005
6006 =cut
6007
6008 sub total_unapplied_payments_pkgnum {
6009   my( $self, $pkgnum ) = @_;
6010   my $total_unapplied = 0;
6011   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
6012   sprintf( "%.2f", $total_unapplied );
6013 }
6014
6015
6016 =item total_unapplied_refunds
6017
6018 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6019 customer.  See L<FS::cust_refund/unapplied>.
6020
6021 =cut
6022
6023 sub total_unapplied_refunds {
6024   my $self = shift;
6025   my $total_unapplied = 0;
6026   $total_unapplied += $_->unapplied foreach $self->cust_refund;
6027   sprintf( "%.2f", $total_unapplied );
6028 }
6029
6030 =item balance
6031
6032 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6033 total_unapplied_credits minus total_unapplied_payments).
6034
6035 =cut
6036
6037 sub balance {
6038   my $self = shift;
6039   sprintf( "%.2f",
6040       $self->total_owed
6041     + $self->total_unapplied_refunds
6042     - $self->total_unapplied_credits
6043     - $self->total_unapplied_payments
6044   );
6045 }
6046
6047 =item balance_date TIME
6048
6049 Returns the balance for this customer, only considering invoices with date
6050 earlier than TIME (total_owed_date minus total_credited minus
6051 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
6052 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
6053 functions.
6054
6055 =cut
6056
6057 sub balance_date {
6058   my $self = shift;
6059   my $time = shift;
6060   sprintf( "%.2f",
6061         $self->total_owed_date($time)
6062       + $self->total_unapplied_refunds
6063       - $self->total_unapplied_credits
6064       - $self->total_unapplied_payments
6065   );
6066 }
6067
6068 =item balance_date_range START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
6069
6070 Returns the balance for this customer, only considering invoices with date
6071 earlier than START_TIME, and optionally not later than END_TIME
6072 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
6073
6074 Times are specified as SQL fragments or numeric
6075 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
6076 L<Date::Parse> for conversion functions.  The empty string can be passed
6077 to disable that time constraint completely.
6078
6079 Available options are:
6080
6081 =over 4
6082
6083 =item unapplied_date
6084
6085 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)
6086
6087 =back
6088
6089 =cut
6090
6091 sub balance_date_range {
6092   my $self = shift;
6093   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
6094             ') FROM cust_main WHERE custnum='. $self->custnum;
6095   sprintf( "%.2f", $self->scalar_sql($sql) );
6096 }
6097
6098 =item balance_pkgnum PKGNUM
6099
6100 Returns the balance for this customer's specific package when using
6101 experimental package balances (total_owed plus total_unrefunded, minus
6102 total_unapplied_credits minus total_unapplied_payments)
6103
6104 =cut
6105
6106 sub balance_pkgnum {
6107   my( $self, $pkgnum ) = @_;
6108
6109   sprintf( "%.2f",
6110       $self->total_owed_pkgnum($pkgnum)
6111 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
6112 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
6113     - $self->total_unapplied_credits_pkgnum($pkgnum)
6114     - $self->total_unapplied_payments_pkgnum($pkgnum)
6115   );
6116 }
6117
6118 =item in_transit_payments
6119
6120 Returns the total of requests for payments for this customer pending in
6121 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
6122
6123 =cut
6124
6125 sub in_transit_payments {
6126   my $self = shift;
6127   my $in_transit_payments = 0;
6128   foreach my $pay_batch ( qsearch('pay_batch', {
6129     'status' => 'I',
6130   } ) ) {
6131     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6132       'batchnum' => $pay_batch->batchnum,
6133       'custnum' => $self->custnum,
6134     } ) ) {
6135       $in_transit_payments += $cust_pay_batch->amount;
6136     }
6137   }
6138   sprintf( "%.2f", $in_transit_payments );
6139 }
6140
6141 =item payment_info
6142
6143 Returns a hash of useful information for making a payment.
6144
6145 =over 4
6146
6147 =item balance
6148
6149 Current balance.
6150
6151 =item payby
6152
6153 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6154 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6155 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6156
6157 =back
6158
6159 For credit card transactions:
6160
6161 =over 4
6162
6163 =item card_type 1
6164
6165 =item payname
6166
6167 Exact name on card
6168
6169 =back
6170
6171 For electronic check transactions:
6172
6173 =over 4
6174
6175 =item stateid_state
6176
6177 =back
6178
6179 =cut
6180
6181 sub payment_info {
6182   my $self = shift;
6183
6184   my %return = ();
6185
6186   $return{balance} = $self->balance;
6187
6188   $return{payname} = $self->payname
6189                      || ( $self->first. ' '. $self->get('last') );
6190
6191   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6192
6193   $return{payby} = $self->payby;
6194   $return{stateid_state} = $self->stateid_state;
6195
6196   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6197     $return{card_type} = cardtype($self->payinfo);
6198     $return{payinfo} = $self->paymask;
6199
6200     @return{'month', 'year'} = $self->paydate_monthyear;
6201
6202   }
6203
6204   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6205     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6206     $return{payinfo1} = $payinfo1;
6207     $return{payinfo2} = $payinfo2;
6208     $return{paytype}  = $self->paytype;
6209     $return{paystate} = $self->paystate;
6210
6211   }
6212
6213   #doubleclick protection
6214   my $_date = time;
6215   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6216
6217   %return;
6218
6219 }
6220
6221 =item paydate_monthyear
6222
6223 Returns a two-element list consisting of the month and year of this customer's
6224 paydate (credit card expiration date for CARD customers)
6225
6226 =cut
6227
6228 sub paydate_monthyear {
6229   my $self = shift;
6230   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6231     ( $2, $1 );
6232   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6233     ( $1, $3 );
6234   } else {
6235     ('', '');
6236   }
6237 }
6238
6239 =item tax_exemption TAXNAME
6240
6241 =cut
6242
6243 sub tax_exemption {
6244   my( $self, $taxname ) = @_;
6245
6246   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
6247                                      'taxname' => $taxname,
6248                                    },
6249           );
6250 }
6251
6252 =item cust_main_exemption
6253
6254 =cut
6255
6256 sub cust_main_exemption {
6257   my $self = shift;
6258   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
6259 }
6260
6261 =item invoicing_list [ ARRAYREF ]
6262
6263 If an arguement is given, sets these email addresses as invoice recipients
6264 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
6265 (except as warnings), so use check_invoicing_list first.
6266
6267 Returns a list of email addresses (with svcnum entries expanded).
6268
6269 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
6270 check it without disturbing anything by passing nothing.
6271
6272 This interface may change in the future.
6273
6274 =cut
6275
6276 sub invoicing_list {
6277   my( $self, $arrayref ) = @_;
6278
6279   if ( $arrayref ) {
6280     my @cust_main_invoice;
6281     if ( $self->custnum ) {
6282       @cust_main_invoice =
6283         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6284     } else {
6285       @cust_main_invoice = ();
6286     }
6287     foreach my $cust_main_invoice ( @cust_main_invoice ) {
6288       #warn $cust_main_invoice->destnum;
6289       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6290         #warn $cust_main_invoice->destnum;
6291         my $error = $cust_main_invoice->delete;
6292         warn $error if $error;
6293       }
6294     }
6295     if ( $self->custnum ) {
6296       @cust_main_invoice =
6297         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6298     } else {
6299       @cust_main_invoice = ();
6300     }
6301     my %seen = map { $_->address => 1 } @cust_main_invoice;
6302     foreach my $address ( @{$arrayref} ) {
6303       next if exists $seen{$address} && $seen{$address};
6304       $seen{$address} = 1;
6305       my $cust_main_invoice = new FS::cust_main_invoice ( {
6306         'custnum' => $self->custnum,
6307         'dest'    => $address,
6308       } );
6309       my $error = $cust_main_invoice->insert;
6310       warn $error if $error;
6311     }
6312   }
6313
6314   if ( $self->custnum ) {
6315     map { $_->address }
6316       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6317   } else {
6318     ();
6319   }
6320
6321 }
6322
6323 =item check_invoicing_list ARRAYREF
6324
6325 Checks these arguements as valid input for the invoicing_list method.  If there
6326 is an error, returns the error, otherwise returns false.
6327
6328 =cut
6329
6330 sub check_invoicing_list {
6331   my( $self, $arrayref ) = @_;
6332
6333   foreach my $address ( @$arrayref ) {
6334
6335     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6336       return 'Can\'t add FAX invoice destination with a blank FAX number.';
6337     }
6338
6339     my $cust_main_invoice = new FS::cust_main_invoice ( {
6340       'custnum' => $self->custnum,
6341       'dest'    => $address,
6342     } );
6343     my $error = $self->custnum
6344                 ? $cust_main_invoice->check
6345                 : $cust_main_invoice->checkdest
6346     ;
6347     return $error if $error;
6348
6349   }
6350
6351   return "Email address required"
6352     if $conf->exists('cust_main-require_invoicing_list_email')
6353     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6354
6355   '';
6356 }
6357
6358 =item set_default_invoicing_list
6359
6360 Sets the invoicing list to all accounts associated with this customer,
6361 overwriting any previous invoicing list.
6362
6363 =cut
6364
6365 sub set_default_invoicing_list {
6366   my $self = shift;
6367   $self->invoicing_list($self->all_emails);
6368 }
6369
6370 =item all_emails
6371
6372 Returns the email addresses of all accounts provisioned for this customer.
6373
6374 =cut
6375
6376 sub all_emails {
6377   my $self = shift;
6378   my %list;
6379   foreach my $cust_pkg ( $self->all_pkgs ) {
6380     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6381     my @svc_acct =
6382       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6383         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6384           @cust_svc;
6385     $list{$_}=1 foreach map { $_->email } @svc_acct;
6386   }
6387   keys %list;
6388 }
6389
6390 =item invoicing_list_addpost
6391
6392 Adds postal invoicing to this customer.  If this customer is already configured
6393 to receive postal invoices, does nothing.
6394
6395 =cut
6396
6397 sub invoicing_list_addpost {
6398   my $self = shift;
6399   return if grep { $_ eq 'POST' } $self->invoicing_list;
6400   my @invoicing_list = $self->invoicing_list;
6401   push @invoicing_list, 'POST';
6402   $self->invoicing_list(\@invoicing_list);
6403 }
6404
6405 =item invoicing_list_emailonly
6406
6407 Returns the list of email invoice recipients (invoicing_list without non-email
6408 destinations such as POST and FAX).
6409
6410 =cut
6411
6412 sub invoicing_list_emailonly {
6413   my $self = shift;
6414   warn "$me invoicing_list_emailonly called"
6415     if $DEBUG;
6416   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6417 }
6418
6419 =item invoicing_list_emailonly_scalar
6420
6421 Returns the list of email invoice recipients (invoicing_list without non-email
6422 destinations such as POST and FAX) as a comma-separated scalar.
6423
6424 =cut
6425
6426 sub invoicing_list_emailonly_scalar {
6427   my $self = shift;
6428   warn "$me invoicing_list_emailonly_scalar called"
6429     if $DEBUG;
6430   join(', ', $self->invoicing_list_emailonly);
6431 }
6432
6433 =item referral_custnum_cust_main
6434
6435 Returns the customer who referred this customer (or the empty string, if
6436 this customer was not referred).
6437
6438 Note the difference with referral_cust_main method: This method,
6439 referral_custnum_cust_main returns the single customer (if any) who referred
6440 this customer, while referral_cust_main returns an array of customers referred
6441 BY this customer.
6442
6443 =cut
6444
6445 sub referral_custnum_cust_main {
6446   my $self = shift;
6447   return '' unless $self->referral_custnum;
6448   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6449 }
6450
6451 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6452
6453 Returns an array of customers referred by this customer (referral_custnum set
6454 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
6455 customers referred by customers referred by this customer and so on, inclusive.
6456 The default behavior is DEPTH 1 (no recursion).
6457
6458 Note the difference with referral_custnum_cust_main method: This method,
6459 referral_cust_main, returns an array of customers referred BY this customer,
6460 while referral_custnum_cust_main returns the single customer (if any) who
6461 referred this customer.
6462
6463 =cut
6464
6465 sub referral_cust_main {
6466   my $self = shift;
6467   my $depth = @_ ? shift : 1;
6468   my $exclude = @_ ? shift : {};
6469
6470   my @cust_main =
6471     map { $exclude->{$_->custnum}++; $_; }
6472       grep { ! $exclude->{ $_->custnum } }
6473         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6474
6475   if ( $depth > 1 ) {
6476     push @cust_main,
6477       map { $_->referral_cust_main($depth-1, $exclude) }
6478         @cust_main;
6479   }
6480
6481   @cust_main;
6482 }
6483
6484 =item referral_cust_main_ncancelled
6485
6486 Same as referral_cust_main, except only returns customers with uncancelled
6487 packages.
6488
6489 =cut
6490
6491 sub referral_cust_main_ncancelled {
6492   my $self = shift;
6493   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6494 }
6495
6496 =item referral_cust_pkg [ DEPTH ]
6497
6498 Like referral_cust_main, except returns a flat list of all unsuspended (and
6499 uncancelled) packages for each customer.  The number of items in this list may
6500 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6501
6502 =cut
6503
6504 sub referral_cust_pkg {
6505   my $self = shift;
6506   my $depth = @_ ? shift : 1;
6507
6508   map { $_->unsuspended_pkgs }
6509     grep { $_->unsuspended_pkgs }
6510       $self->referral_cust_main($depth);
6511 }
6512
6513 =item referring_cust_main
6514
6515 Returns the single cust_main record for the customer who referred this customer
6516 (referral_custnum), or false.
6517
6518 =cut
6519
6520 sub referring_cust_main {
6521   my $self = shift;
6522   return '' unless $self->referral_custnum;
6523   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6524 }
6525
6526 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6527
6528 Applies a credit to this customer.  If there is an error, returns the error,
6529 otherwise returns false.
6530
6531 REASON can be a text string, an FS::reason object, or a scalar reference to
6532 a reasonnum.  If a text string, it will be automatically inserted as a new
6533 reason, and a 'reason_type' option must be passed to indicate the
6534 FS::reason_type for the new reason.
6535
6536 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6537
6538 Any other options are passed to FS::cust_credit::insert.
6539
6540 =cut
6541
6542 sub credit {
6543   my( $self, $amount, $reason, %options ) = @_;
6544
6545   my $cust_credit = new FS::cust_credit {
6546     'custnum' => $self->custnum,
6547     'amount'  => $amount,
6548   };
6549
6550   if ( ref($reason) ) {
6551
6552     if ( ref($reason) eq 'SCALAR' ) {
6553       $cust_credit->reasonnum( $$reason );
6554     } else {
6555       $cust_credit->reasonnum( $reason->reasonnum );
6556     }
6557
6558   } else {
6559     $cust_credit->set('reason', $reason)
6560   }
6561
6562   for (qw( addlinfo eventnum )) {
6563     $cust_credit->$_( delete $options{$_} )
6564       if exists($options{$_});
6565   }
6566
6567   $cust_credit->insert(%options);
6568
6569 }
6570
6571 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6572
6573 Creates a one-time charge for this customer.  If there is an error, returns
6574 the error, otherwise returns false.
6575
6576 New-style, with a hashref of options:
6577
6578   my $error = $cust_main->charge(
6579                                   {
6580                                     'amount'     => 54.32,
6581                                     'quantity'   => 1,
6582                                     'start_date' => str2time('7/4/2009'),
6583                                     'pkg'        => 'Description',
6584                                     'comment'    => 'Comment',
6585                                     'additional' => [], #extra invoice detail
6586                                     'classnum'   => 1,  #pkg_class
6587
6588                                     'setuptax'   => '', # or 'Y' for tax exempt
6589
6590                                     #internal taxation
6591                                     'taxclass'   => 'Tax class',
6592
6593                                     #vendor taxation
6594                                     'taxproduct' => 2,  #part_pkg_taxproduct
6595                                     'override'   => {}, #XXX describe
6596
6597                                     #will be filled in with the new object
6598                                     'cust_pkg_ref' => \$cust_pkg,
6599
6600                                     #generate an invoice immediately
6601                                     'bill_now' => 0,
6602                                     'invoice_terms' => '', #with these terms
6603                                   }
6604                                 );
6605
6606 Old-style:
6607
6608   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
6609
6610 =cut
6611
6612 sub charge {
6613   my $self = shift;
6614   my ( $amount, $quantity, $start_date, $classnum );
6615   my ( $pkg, $comment, $additional );
6616   my ( $setuptax, $taxclass );   #internal taxes
6617   my ( $taxproduct, $override ); #vendor (CCH) taxes
6618   my $no_auto = '';
6619   my $cust_pkg_ref = '';
6620   my ( $bill_now, $invoice_terms ) = ( 0, '' );
6621   if ( ref( $_[0] ) ) {
6622     $amount     = $_[0]->{amount};
6623     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6624     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
6625     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
6626     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6627     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
6628                                            : '$'. sprintf("%.2f",$amount);
6629     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6630     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6631     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6632     $additional = $_[0]->{additional} || [];
6633     $taxproduct = $_[0]->{taxproductnum};
6634     $override   = { '' => $_[0]->{tax_override} };
6635     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
6636     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
6637     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
6638   } else {
6639     $amount     = shift;
6640     $quantity   = 1;
6641     $start_date = '';
6642     $pkg        = @_ ? shift : 'One-time charge';
6643     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
6644     $setuptax   = '';
6645     $taxclass   = @_ ? shift : '';
6646     $additional = [];
6647   }
6648
6649   local $SIG{HUP} = 'IGNORE';
6650   local $SIG{INT} = 'IGNORE';
6651   local $SIG{QUIT} = 'IGNORE';
6652   local $SIG{TERM} = 'IGNORE';
6653   local $SIG{TSTP} = 'IGNORE';
6654   local $SIG{PIPE} = 'IGNORE';
6655
6656   my $oldAutoCommit = $FS::UID::AutoCommit;
6657   local $FS::UID::AutoCommit = 0;
6658   my $dbh = dbh;
6659
6660   my $part_pkg = new FS::part_pkg ( {
6661     'pkg'           => $pkg,
6662     'comment'       => $comment,
6663     'plan'          => 'flat',
6664     'freq'          => 0,
6665     'disabled'      => 'Y',
6666     'classnum'      => ( $classnum ? $classnum : '' ),
6667     'setuptax'      => $setuptax,
6668     'taxclass'      => $taxclass,
6669     'taxproductnum' => $taxproduct,
6670   } );
6671
6672   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6673                         ( 0 .. @$additional - 1 )
6674                   ),
6675                   'additional_count' => scalar(@$additional),
6676                   'setup_fee' => $amount,
6677                 );
6678
6679   my $error = $part_pkg->insert( options       => \%options,
6680                                  tax_overrides => $override,
6681                                );
6682   if ( $error ) {
6683     $dbh->rollback if $oldAutoCommit;
6684     return $error;
6685   }
6686
6687   my $pkgpart = $part_pkg->pkgpart;
6688   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6689   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6690     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6691     $error = $type_pkgs->insert;
6692     if ( $error ) {
6693       $dbh->rollback if $oldAutoCommit;
6694       return $error;
6695     }
6696   }
6697
6698   my $cust_pkg = new FS::cust_pkg ( {
6699     'custnum'    => $self->custnum,
6700     'pkgpart'    => $pkgpart,
6701     'quantity'   => $quantity,
6702     'start_date' => $start_date,
6703     'no_auto'    => $no_auto,
6704   } );
6705
6706   $error = $cust_pkg->insert;
6707   if ( $error ) {
6708     $dbh->rollback if $oldAutoCommit;
6709     return $error;
6710   } elsif ( $cust_pkg_ref ) {
6711     ${$cust_pkg_ref} = $cust_pkg;
6712   }
6713
6714   if ( $bill_now ) {
6715     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
6716                              'pkg_list'      => [ $cust_pkg ],
6717                            );
6718     if ( $error ) {
6719       $dbh->rollback if $oldAutoCommit;
6720       return $error;
6721     }
6722   }
6723
6724   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6725   return '';
6726
6727 }
6728
6729 #=item charge_postal_fee
6730 #
6731 #Applies a one time charge this customer.  If there is an error,
6732 #returns the error, returns the cust_pkg charge object or false
6733 #if there was no charge.
6734 #
6735 #=cut
6736 #
6737 # This should be a customer event.  For that to work requires that bill
6738 # also be a customer event.
6739
6740 sub charge_postal_fee {
6741   my $self = shift;
6742
6743   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
6744   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
6745
6746   my $cust_pkg = new FS::cust_pkg ( {
6747     'custnum'  => $self->custnum,
6748     'pkgpart'  => $pkgpart,
6749     'quantity' => 1,
6750   } );
6751
6752   my $error = $cust_pkg->insert;
6753   $error ? $error : $cust_pkg;
6754 }
6755
6756 =item cust_bill
6757
6758 Returns all the invoices (see L<FS::cust_bill>) for this customer.
6759
6760 =cut
6761
6762 sub cust_bill {
6763   my $self = shift;
6764   map { $_ } #return $self->num_cust_bill unless wantarray;
6765   sort { $a->_date <=> $b->_date }
6766     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6767 }
6768
6769 =item open_cust_bill
6770
6771 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
6772 customer.
6773
6774 =cut
6775
6776 sub open_cust_bill {
6777   my $self = shift;
6778
6779   qsearch({
6780     'table'     => 'cust_bill',
6781     'hashref'   => { 'custnum' => $self->custnum, },
6782     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
6783     'order_by'  => 'ORDER BY _date ASC',
6784   });
6785
6786 }
6787
6788 =item cust_statements
6789
6790 Returns all the statements (see L<FS::cust_statement>) for this customer.
6791
6792 =cut
6793
6794 sub cust_statement {
6795   my $self = shift;
6796   map { $_ } #return $self->num_cust_statement unless wantarray;
6797   sort { $a->_date <=> $b->_date }
6798     qsearch('cust_statement', { 'custnum' => $self->custnum, } )
6799 }
6800
6801 =item cust_credit
6802
6803 Returns all the credits (see L<FS::cust_credit>) for this customer.
6804
6805 =cut
6806
6807 sub cust_credit {
6808   my $self = shift;
6809   map { $_ } #return $self->num_cust_credit unless wantarray;
6810   sort { $a->_date <=> $b->_date }
6811     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
6812 }
6813
6814 =item cust_credit_pkgnum
6815
6816 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
6817 package when using experimental package balances.
6818
6819 =cut
6820
6821 sub cust_credit_pkgnum {
6822   my( $self, $pkgnum ) = @_;
6823   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
6824   sort { $a->_date <=> $b->_date }
6825     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
6826                               'pkgnum'  => $pkgnum,
6827                             }
6828     );
6829 }
6830
6831 =item cust_pay
6832
6833 Returns all the payments (see L<FS::cust_pay>) for this customer.
6834
6835 =cut
6836
6837 sub cust_pay {
6838   my $self = shift;
6839   return $self->num_cust_pay unless wantarray;
6840   sort { $a->_date <=> $b->_date }
6841     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
6842 }
6843
6844 =item num_cust_pay
6845
6846 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
6847 called automatically when the cust_pay method is used in a scalar context.
6848
6849 =cut
6850
6851 sub num_cust_pay {
6852   my $self = shift;
6853   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
6854   my $sth = dbh->prepare($sql) or die dbh->errstr;
6855   $sth->execute($self->custnum) or die $sth->errstr;
6856   $sth->fetchrow_arrayref->[0];
6857 }
6858
6859 =item cust_pay_pkgnum
6860
6861 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
6862 package when using experimental package balances.
6863
6864 =cut
6865
6866 sub cust_pay_pkgnum {
6867   my( $self, $pkgnum ) = @_;
6868   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
6869   sort { $a->_date <=> $b->_date }
6870     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
6871                            'pkgnum'  => $pkgnum,
6872                          }
6873     );
6874 }
6875
6876 =item cust_pay_void
6877
6878 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
6879
6880 =cut
6881
6882 sub cust_pay_void {
6883   my $self = shift;
6884   map { $_ } #return $self->num_cust_pay_void unless wantarray;
6885   sort { $a->_date <=> $b->_date }
6886     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
6887 }
6888
6889 =item cust_pay_batch
6890
6891 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
6892
6893 =cut
6894
6895 sub cust_pay_batch {
6896   my $self = shift;
6897   map { $_ } #return $self->num_cust_pay_batch unless wantarray;
6898   sort { $a->paybatchnum <=> $b->paybatchnum }
6899     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
6900 }
6901
6902 =item cust_pay_pending
6903
6904 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
6905 (without status "done").
6906
6907 =cut
6908
6909 sub cust_pay_pending {
6910   my $self = shift;
6911   return $self->num_cust_pay_pending unless wantarray;
6912   sort { $a->_date <=> $b->_date }
6913     qsearch( 'cust_pay_pending', {
6914                                    'custnum' => $self->custnum,
6915                                    'status'  => { op=>'!=', value=>'done' },
6916                                  },
6917            );
6918 }
6919
6920 =item num_cust_pay_pending
6921
6922 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
6923 customer (without status "done").  Also called automatically when the
6924 cust_pay_pending method is used in a scalar context.
6925
6926 =cut
6927
6928 sub num_cust_pay_pending {
6929   my $self = shift;
6930   my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
6931             "   WHERE custnum = ? AND status != 'done' ";
6932   my $sth = dbh->prepare($sql) or die dbh->errstr;
6933   $sth->execute($self->custnum) or die $sth->errstr;
6934   $sth->fetchrow_arrayref->[0];
6935 }
6936
6937 =item cust_refund
6938
6939 Returns all the refunds (see L<FS::cust_refund>) for this customer.
6940
6941 =cut
6942
6943 sub cust_refund {
6944   my $self = shift;
6945   map { $_ } #return $self->num_cust_refund unless wantarray;
6946   sort { $a->_date <=> $b->_date }
6947     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
6948 }
6949
6950 =item display_custnum
6951
6952 Returns the displayed customer number for this customer: agent_custid if
6953 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
6954
6955 =cut
6956
6957 sub display_custnum {
6958   my $self = shift;
6959   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
6960     return $self->agent_custid;
6961   } else {
6962     return $self->custnum;
6963   }
6964 }
6965
6966 =item name
6967
6968 Returns a name string for this customer, either "Company (Last, First)" or
6969 "Last, First".
6970
6971 =cut
6972
6973 sub name {
6974   my $self = shift;
6975   my $name = $self->contact;
6976   $name = $self->company. " ($name)" if $self->company;
6977   $name;
6978 }
6979
6980 =item ship_name
6981
6982 Returns a name string for this (service/shipping) contact, either
6983 "Company (Last, First)" or "Last, First".
6984
6985 =cut
6986
6987 sub ship_name {
6988   my $self = shift;
6989   if ( $self->get('ship_last') ) {
6990     my $name = $self->ship_contact;
6991     $name = $self->ship_company. " ($name)" if $self->ship_company;
6992     $name;
6993   } else {
6994     $self->name;
6995   }
6996 }
6997
6998 =item name_short
6999
7000 Returns a name string for this customer, either "Company" or "First Last".
7001
7002 =cut
7003
7004 sub name_short {
7005   my $self = shift;
7006   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
7007 }
7008
7009 =item ship_name_short
7010
7011 Returns a name string for this (service/shipping) contact, either "Company"
7012 or "First Last".
7013
7014 =cut
7015
7016 sub ship_name_short {
7017   my $self = shift;
7018   if ( $self->get('ship_last') ) {
7019     $self->ship_company !~ /^\s*$/
7020       ? $self->ship_company
7021       : $self->ship_contact_firstlast;
7022   } else {
7023     $self->name_company_or_firstlast;
7024   }
7025 }
7026
7027 =item contact
7028
7029 Returns this customer's full (billing) contact name only, "Last, First"
7030
7031 =cut
7032
7033 sub contact {
7034   my $self = shift;
7035   $self->get('last'). ', '. $self->first;
7036 }
7037
7038 =item ship_contact
7039
7040 Returns this customer's full (shipping) contact name only, "Last, First"
7041
7042 =cut
7043
7044 sub ship_contact {
7045   my $self = shift;
7046   $self->get('ship_last')
7047     ? $self->get('ship_last'). ', '. $self->ship_first
7048     : $self->contact;
7049 }
7050
7051 =item contact_firstlast
7052
7053 Returns this customers full (billing) contact name only, "First Last".
7054
7055 =cut
7056
7057 sub contact_firstlast {
7058   my $self = shift;
7059   $self->first. ' '. $self->get('last');
7060 }
7061
7062 =item ship_contact_firstlast
7063
7064 Returns this customer's full (shipping) contact name only, "First Last".
7065
7066 =cut
7067
7068 sub ship_contact_firstlast {
7069   my $self = shift;
7070   $self->get('ship_last')
7071     ? $self->first. ' '. $self->get('ship_last')
7072     : $self->contact_firstlast;
7073 }
7074
7075 =item country_full
7076
7077 Returns this customer's full country name
7078
7079 =cut
7080
7081 sub country_full {
7082   my $self = shift;
7083   code2country($self->country);
7084 }
7085
7086 =item geocode DATA_VENDOR
7087
7088 Returns a value for the customer location as encoded by DATA_VENDOR.
7089 Currently this only makes sense for "CCH" as DATA_VENDOR.
7090
7091 =cut
7092
7093 sub geocode {
7094   my ($self, $data_vendor) = (shift, shift);  #always cch for now
7095
7096   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
7097   return $geocode if $geocode;
7098
7099   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7100                ? 'ship_'
7101                : '';
7102
7103   my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7104     if $self->country eq 'US';
7105
7106   $zip ||= '';
7107   $plus4 ||= '';
7108   #CCH specific location stuff
7109   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7110
7111   my @cust_tax_location =
7112     qsearch( {
7113                'table'     => 'cust_tax_location',
7114                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7115                'extra_sql' => $extra_sql,
7116                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
7117              }
7118            );
7119   $geocode = $cust_tax_location[0]->geocode
7120     if scalar(@cust_tax_location);
7121
7122   $geocode;
7123 }
7124
7125 =item cust_status
7126
7127 =item status
7128
7129 Returns a status string for this customer, currently:
7130
7131 =over 4
7132
7133 =item prospect - No packages have ever been ordered
7134
7135 =item active - One or more recurring packages is active
7136
7137 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7138
7139 =item suspended - All non-cancelled recurring packages are suspended
7140
7141 =item cancelled - All recurring packages are cancelled
7142
7143 =back
7144
7145 =cut
7146
7147 sub status { shift->cust_status(@_); }
7148
7149 sub cust_status {
7150   my $self = shift;
7151   for my $status (qw( prospect active inactive suspended cancelled )) {
7152     my $method = $status.'_sql';
7153     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7154     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7155     $sth->execute( ($self->custnum) x $numnum )
7156       or die "Error executing 'SELECT $sql': ". $sth->errstr;
7157     return $status if $sth->fetchrow_arrayref->[0];
7158   }
7159 }
7160
7161 =item ucfirst_cust_status
7162
7163 =item ucfirst_status
7164
7165 Returns the status with the first character capitalized.
7166
7167 =cut
7168
7169 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7170
7171 sub ucfirst_cust_status {
7172   my $self = shift;
7173   ucfirst($self->cust_status);
7174 }
7175
7176 =item statuscolor
7177
7178 Returns a hex triplet color string for this customer's status.
7179
7180 =cut
7181
7182 use vars qw(%statuscolor);
7183 tie %statuscolor, 'Tie::IxHash',
7184   'prospect'  => '7e0079', #'000000', #black?  naw, purple
7185   'active'    => '00CC00', #green
7186   'inactive'  => '0000CC', #blue
7187   'suspended' => 'FF9900', #yellow
7188   'cancelled' => 'FF0000', #red
7189 ;
7190
7191 sub statuscolor { shift->cust_statuscolor(@_); }
7192
7193 sub cust_statuscolor {
7194   my $self = shift;
7195   $statuscolor{$self->cust_status};
7196 }
7197
7198 =item tickets
7199
7200 Returns an array of hashes representing the customer's RT tickets.
7201
7202 =cut
7203
7204 sub tickets {
7205   my $self = shift;
7206
7207   my $num = $conf->config('cust_main-max_tickets') || 10;
7208   my @tickets = ();
7209
7210   if ( $conf->config('ticket_system') ) {
7211     unless ( $conf->config('ticket_system-custom_priority_field') ) {
7212
7213       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7214
7215     } else {
7216
7217       foreach my $priority (
7218         $conf->config('ticket_system-custom_priority_field-values'), ''
7219       ) {
7220         last if scalar(@tickets) >= $num;
7221         push @tickets,
7222           @{ FS::TicketSystem->customer_tickets( $self->custnum,
7223                                                  $num - scalar(@tickets),
7224                                                  $priority,
7225                                                )
7226            };
7227       }
7228     }
7229   }
7230   (@tickets);
7231 }
7232
7233 # Return services representing svc_accts in customer support packages
7234 sub support_services {
7235   my $self = shift;
7236   my %packages = map { $_ => 1 } $conf->config('support_packages');
7237
7238   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7239     grep { $_->part_svc->svcdb eq 'svc_acct' }
7240     map { $_->cust_svc }
7241     grep { exists $packages{ $_->pkgpart } }
7242     $self->ncancelled_pkgs;
7243
7244 }
7245
7246 # Return a list of latitude/longitude for one of the services (if any)
7247 sub service_coordinates {
7248   my $self = shift;
7249
7250   my @svc_X =
7251     grep { $_->latitude && $_->longitude }
7252     map { $_->svc_x }
7253     map { $_->cust_svc }
7254     $self->ncancelled_pkgs;
7255
7256   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
7257 }
7258
7259 =back
7260
7261 =head1 CLASS METHODS
7262
7263 =over 4
7264
7265 =item statuses
7266
7267 Class method that returns the list of possible status strings for customers
7268 (see L<the status method|/status>).  For example:
7269
7270   @statuses = FS::cust_main->statuses();
7271
7272 =cut
7273
7274 sub statuses {
7275   #my $self = shift; #could be class...
7276   keys %statuscolor;
7277 }
7278
7279 =item prospect_sql
7280
7281 Returns an SQL expression identifying prospective cust_main records (customers
7282 with no packages ever ordered)
7283
7284 =cut
7285
7286 use vars qw($select_count_pkgs);
7287 $select_count_pkgs =
7288   "SELECT COUNT(*) FROM cust_pkg
7289     WHERE cust_pkg.custnum = cust_main.custnum";
7290
7291 sub select_count_pkgs_sql {
7292   $select_count_pkgs;
7293 }
7294
7295 sub prospect_sql { "
7296   0 = ( $select_count_pkgs )
7297 "; }
7298
7299 =item active_sql
7300
7301 Returns an SQL expression identifying active cust_main records (customers with
7302 active recurring packages).
7303
7304 =cut
7305
7306 sub active_sql { "
7307   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
7308       )
7309 "; }
7310
7311 =item inactive_sql
7312
7313 Returns an SQL expression identifying inactive cust_main records (customers with
7314 no active recurring packages, but otherwise unsuspended/uncancelled).
7315
7316 =cut
7317
7318 sub inactive_sql { "
7319   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7320   AND
7321   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7322 "; }
7323
7324 =item susp_sql
7325 =item suspended_sql
7326
7327 Returns an SQL expression identifying suspended cust_main records.
7328
7329 =cut
7330
7331
7332 sub suspended_sql { susp_sql(@_); }
7333 sub susp_sql { "
7334     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7335     AND
7336     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7337 "; }
7338
7339 =item cancel_sql
7340 =item cancelled_sql
7341
7342 Returns an SQL expression identifying cancelled cust_main records.
7343
7344 =cut
7345
7346 sub cancelled_sql { cancel_sql(@_); }
7347 sub cancel_sql {
7348
7349   my $recurring_sql = FS::cust_pkg->recurring_sql;
7350   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7351
7352   "
7353         0 < ( $select_count_pkgs )
7354     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
7355     AND 0 = ( $select_count_pkgs AND $recurring_sql
7356                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7357             )
7358     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7359   ";
7360
7361 }
7362
7363 =item uncancel_sql
7364 =item uncancelled_sql
7365
7366 Returns an SQL expression identifying un-cancelled cust_main records.
7367
7368 =cut
7369
7370 sub uncancelled_sql { uncancel_sql(@_); }
7371 sub uncancel_sql { "
7372   ( 0 < ( $select_count_pkgs
7373                    AND ( cust_pkg.cancel IS NULL
7374                          OR cust_pkg.cancel = 0
7375                        )
7376         )
7377     OR 0 = ( $select_count_pkgs )
7378   )
7379 "; }
7380
7381 =item balance_sql
7382
7383 Returns an SQL fragment to retreive the balance.
7384
7385 =cut
7386
7387 sub balance_sql { "
7388     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7389         WHERE cust_bill.custnum   = cust_main.custnum     )
7390   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
7391         WHERE cust_pay.custnum    = cust_main.custnum     )
7392   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
7393         WHERE cust_credit.custnum = cust_main.custnum     )
7394   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
7395         WHERE cust_refund.custnum = cust_main.custnum     )
7396 "; }
7397
7398 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7399
7400 Returns an SQL fragment to retreive the balance for this customer, only
7401 considering invoices with date earlier than START_TIME, and optionally not
7402 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7403 total_unapplied_payments).
7404
7405 Times are specified as SQL fragments or numeric
7406 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
7407 L<Date::Parse> for conversion functions.  The empty string can be passed
7408 to disable that time constraint completely.
7409
7410 Available options are:
7411
7412 =over 4
7413
7414 =item unapplied_date
7415
7416 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)
7417
7418 =item total
7419
7420 (unused.  obsolete?)
7421 set to true to remove all customer comparison clauses, for totals
7422
7423 =item where
7424
7425 (unused.  obsolete?)
7426 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7427
7428 =item join
7429
7430 (unused.  obsolete?)
7431 JOIN clause (typically used with the total option)
7432
7433 =item cutoff
7434
7435 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
7436 time will be ignored.  Note that START_TIME and END_TIME only limit the date
7437 range for invoices and I<unapplied> payments, credits, and refunds.
7438
7439 =back
7440
7441 =cut
7442
7443 sub balance_date_sql {
7444   my( $class, $start, $end, %opt ) = @_;
7445
7446   my $cutoff = $opt{'cutoff'};
7447
7448   my $owed         = FS::cust_bill->owed_sql($cutoff);
7449   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
7450   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
7451   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
7452
7453   my $j = $opt{'join'} || '';
7454
7455   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
7456   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7457   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7458   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
7459
7460   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
7461     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7462     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7463     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
7464   ";
7465
7466 }
7467
7468 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
7469
7470 Returns an SQL fragment to retreive the total unapplied payments for this
7471 customer, only considering invoices with date earlier than START_TIME, and
7472 optionally not later than END_TIME.
7473
7474 Times are specified as SQL fragments or numeric
7475 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
7476 L<Date::Parse> for conversion functions.  The empty string can be passed
7477 to disable that time constraint completely.
7478
7479 Available options are:
7480
7481 =cut
7482
7483 sub unapplied_payments_date_sql {
7484   my( $class, $start, $end, %opt ) = @_;
7485
7486   my $cutoff = $opt{'cutoff'};
7487
7488   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
7489
7490   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
7491                                                           'unapplied_date'=>1 );
7492
7493   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
7494 }
7495
7496 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7497
7498 Helper method for balance_date_sql; name (and usage) subject to change
7499 (suggestions welcome).
7500
7501 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7502 cust_refund, cust_credit or cust_pay).
7503
7504 If TABLE is "cust_bill" or the unapplied_date option is true, only
7505 considers records with date earlier than START_TIME, and optionally not
7506 later than END_TIME .
7507
7508 =cut
7509
7510 sub _money_table_where {
7511   my( $class, $table, $start, $end, %opt ) = @_;
7512
7513   my @where = ();
7514   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7515   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7516     push @where, "$table._date <= $start" if defined($start) && length($start);
7517     push @where, "$table._date >  $end"   if defined($end)   && length($end);
7518   }
7519   push @where, @{$opt{'where'}} if $opt{'where'};
7520   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7521
7522   $where;
7523
7524 }
7525
7526 =item search HASHREF
7527
7528 (Class method)
7529
7530 Returns a qsearch hash expression to search for parameters specified in
7531 HASHREF.  Valid parameters are
7532
7533 =over 4
7534
7535 =item agentnum
7536
7537 =item status
7538
7539 =item cancelled_pkgs
7540
7541 bool
7542
7543 =item signupdate
7544
7545 listref of start date, end date
7546
7547 =item payby
7548
7549 listref
7550
7551 =item paydate_year
7552
7553 =item paydate_month
7554
7555 =item current_balance
7556
7557 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7558
7559 =item cust_fields
7560
7561 =item flattened_pkgs
7562
7563 bool
7564
7565 =back
7566
7567 =cut
7568
7569 sub search {
7570   my ($class, $params) = @_;
7571
7572   my $dbh = dbh;
7573
7574   my @where = ();
7575   my $orderby;
7576
7577   ##
7578   # parse agent
7579   ##
7580
7581   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7582     push @where,
7583       "cust_main.agentnum = $1";
7584   }
7585
7586   ##
7587   # do the same for user
7588   ##
7589
7590   if ( $params->{'usernum'} =~ /^(\d+)$/ and $1 ) {
7591     push @where,
7592       "cust_main.usernum = $1";
7593   }
7594
7595   ##
7596   # parse status
7597   ##
7598
7599   #prospect active inactive suspended cancelled
7600   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7601     my $method = $params->{'status'}. '_sql';
7602     #push @where, $class->$method();
7603     push @where, FS::cust_main->$method();
7604   }
7605
7606   ##
7607   # parse cancelled package checkbox
7608   ##
7609
7610   my $pkgwhere = "";
7611
7612   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7613     unless $params->{'cancelled_pkgs'};
7614
7615   ##
7616   # parse without census tract checkbox
7617   ##
7618
7619   push @where, "(censustract = '' or censustract is null)"
7620     if $params->{'no_censustract'};
7621
7622   ##
7623   # dates
7624   ##
7625
7626   foreach my $field (qw( signupdate )) {
7627
7628     next unless exists($params->{$field});
7629
7630     my($beginning, $ending, $hour) = @{$params->{$field}};
7631
7632     push @where,
7633       "cust_main.$field IS NOT NULL",
7634       "cust_main.$field >= $beginning",
7635       "cust_main.$field <= $ending";
7636
7637     # XXX: do this for mysql and/or pull it out of here
7638     if(defined $hour) {
7639       if ($dbh->{Driver}->{Name} eq 'Pg') {
7640         push @where, "extract(hour from to_timestamp(cust_main.$field)) = $hour";
7641       }
7642       else {
7643         warn "search by time of day not supported on ".$dbh->{Driver}->{Name}." databases";
7644       }
7645     }
7646
7647     $orderby ||= "ORDER BY cust_main.$field";
7648
7649   }
7650
7651   ###
7652   # classnum
7653   ###
7654
7655   if ( $params->{'classnum'} ) {
7656
7657     my @classnum = ref( $params->{'classnum'} )
7658                      ? @{ $params->{'classnum'} }
7659                      :  ( $params->{'classnum'} );
7660
7661     @classnum = grep /^(\d*)$/, @classnum;
7662
7663     if ( @classnum ) {
7664       push @where, '( '. join(' OR ', map {
7665                                             $_ ? "cust_main.classnum = $_"
7666                                                : "cust_main.classnum IS NULL"
7667                                           }
7668                                           @classnum
7669                              ).
7670                    ' )';
7671     }
7672
7673   }
7674
7675   ###
7676   # payby
7677   ###
7678
7679   if ( $params->{'payby'} ) {
7680
7681     my @payby = ref( $params->{'payby'} )
7682                   ? @{ $params->{'payby'} }
7683                   :  ( $params->{'payby'} );
7684
7685     @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
7686
7687     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )'
7688       if @payby;
7689
7690   }
7691
7692   ###
7693   # paydate_year / paydate_month
7694   ###
7695
7696   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
7697     my $year = $1;
7698     $params->{'paydate_month'} =~ /^(\d\d?)$/
7699       or die "paydate_year without paydate_month?";
7700     my $month = $1;
7701
7702     push @where,
7703       'paydate IS NOT NULL',
7704       "paydate != ''",
7705       "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
7706 ;
7707   }
7708
7709   ###
7710   # invoice terms
7711   ###
7712
7713   if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
7714     my $terms = $1;
7715     if ( $1 eq 'NULL' ) {
7716       push @where,
7717         "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
7718     } else {
7719       push @where,
7720         "cust_main.invoice_terms IS NOT NULL",
7721         "cust_main.invoice_terms = '$1'";
7722     }
7723   }
7724
7725   ##
7726   # amounts
7727   ##
7728
7729   if ( $params->{'current_balance'} ) {
7730
7731     #my $balance_sql = $class->balance_sql();
7732     my $balance_sql = FS::cust_main->balance_sql();
7733
7734     my @current_balance =
7735       ref( $params->{'current_balance'} )
7736       ? @{ $params->{'current_balance'} }
7737       :  ( $params->{'current_balance'} );
7738
7739     push @where, map { s/current_balance/$balance_sql/; $_ }
7740                      @current_balance;
7741
7742   }
7743
7744   ##
7745   # custbatch
7746   ##
7747
7748   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
7749     push @where,
7750       "cust_main.custbatch = '$1'";
7751   }
7752
7753   ##
7754   # setup queries, subs, etc. for the search
7755   ##
7756
7757   $orderby ||= 'ORDER BY custnum';
7758
7759   # here is the agent virtualization
7760   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
7761
7762   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
7763
7764   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
7765
7766   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
7767
7768   my $select = join(', ',
7769                  'cust_main.custnum',
7770                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
7771                );
7772
7773   my(@extra_headers) = ();
7774   my(@extra_fields)  = ();
7775
7776   if ($params->{'flattened_pkgs'}) {
7777
7778     if ($dbh->{Driver}->{Name} eq 'Pg') {
7779
7780       $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";
7781
7782     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
7783       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
7784       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
7785     }else{
7786       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
7787            "omitting packing information from report.";
7788     }
7789
7790     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";
7791
7792     my $sth = dbh->prepare($header_query) or die dbh->errstr;
7793     $sth->execute() or die $sth->errstr;
7794     my $headerrow = $sth->fetchrow_arrayref;
7795     my $headercount = $headerrow ? $headerrow->[0] : 0;
7796     while($headercount) {
7797       unshift @extra_headers, "Package ". $headercount;
7798       unshift @extra_fields, eval q!sub {my $c = shift;
7799                                          my @a = split '\|', $c->magic;
7800                                          my $p = $a[!.--$headercount. q!];
7801                                          $p;
7802                                         };!;
7803     }
7804
7805   }
7806
7807   my $sql_query = {
7808     'table'         => 'cust_main',
7809     'select'        => $select,
7810     'hashref'       => {},
7811     'extra_sql'     => $extra_sql,
7812     'order_by'      => $orderby,
7813     'count_query'   => $count_query,
7814     'extra_headers' => \@extra_headers,
7815     'extra_fields'  => \@extra_fields,
7816   };
7817
7818 }
7819
7820 =item email_search_result HASHREF
7821
7822 (Class method)
7823
7824 Emails a notice to the specified customers.
7825
7826 Valid parameters are those of the L<search> method, plus the following:
7827
7828 =over 4
7829
7830 =item from
7831
7832 From: address
7833
7834 =item subject
7835
7836 Email Subject:
7837
7838 =item html_body
7839
7840 HTML body
7841
7842 =item text_body
7843
7844 Text body
7845
7846 =item job
7847
7848 Optional job queue job for status updates.
7849
7850 =back
7851
7852 Returns an error message, or false for success.
7853
7854 If an error occurs during any email, stops the enture send and returns that
7855 error.  Presumably if you're getting SMTP errors aborting is better than
7856 retrying everything.
7857
7858 =cut
7859
7860 sub email_search_result {
7861   my($class, $params) = @_;
7862
7863   my $from = delete $params->{from};
7864   my $subject = delete $params->{subject};
7865   my $html_body = delete $params->{html_body};
7866   my $text_body = delete $params->{text_body};
7867
7868   my $job = delete $params->{'job'};
7869
7870   $params->{'payby'} = [ split(/\0/, $params->{'payby'}) ]
7871     unless ref($params->{'payby'});
7872
7873   my $sql_query = $class->search($params);
7874
7875   my $count_query   = delete($sql_query->{'count_query'});
7876   my $count_sth = dbh->prepare($count_query)
7877     or die "Error preparing $count_query: ". dbh->errstr;
7878   $count_sth->execute
7879     or die "Error executing $count_query: ". $count_sth->errstr;
7880   my $count_arrayref = $count_sth->fetchrow_arrayref;
7881   my $num_cust = $count_arrayref->[0];
7882
7883   #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
7884   #my @extra_fields  = @{ delete($sql_query->{'extra_fields'})  };
7885
7886
7887   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
7888
7889   #eventually order+limit magic to reduce memory use?
7890   foreach my $cust_main ( qsearch($sql_query) ) {
7891
7892     my $to = $cust_main->invoicing_list_emailonly_scalar;
7893     next unless $to;
7894
7895     my $error = send_email(
7896       generate_email(
7897         'from'      => $from,
7898         'to'        => $to,
7899         'subject'   => $subject,
7900         'html_body' => $html_body,
7901         'text_body' => $text_body,
7902       )
7903     );
7904     return $error if $error;
7905
7906     if ( $job ) { #progressbar foo
7907       $num++;
7908       if ( time - $min_sec > $last ) {
7909         my $error = $job->update_statustext(
7910           int( 100 * $num / $num_cust )
7911         );
7912         die $error if $error;
7913         $last = time;
7914       }
7915     }
7916
7917   }
7918
7919   return '';
7920 }
7921
7922 use Storable qw(thaw);
7923 use Data::Dumper;
7924 use MIME::Base64;
7925 sub process_email_search_result {
7926   my $job = shift;
7927   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
7928
7929   my $param = thaw(decode_base64(shift));
7930   warn Dumper($param) if $DEBUG;
7931
7932   $param->{'job'} = $job;
7933
7934   $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
7935     unless ref($param->{'payby'});
7936
7937   my $error = FS::cust_main->email_search_result( $param );
7938   die $error if $error;
7939
7940 }
7941
7942 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
7943
7944 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
7945 records.  Currently, I<first>, I<last>, I<company> and/or I<address1> may be
7946 specified (the appropriate ship_ field is also searched).
7947
7948 Additional options are the same as FS::Record::qsearch
7949
7950 =cut
7951
7952 sub fuzzy_search {
7953   my( $self, $fuzzy, $hash, @opt) = @_;
7954   #$self
7955   $hash ||= {};
7956   my @cust_main = ();
7957
7958   check_and_rebuild_fuzzyfiles();
7959   foreach my $field ( keys %$fuzzy ) {
7960
7961     my $all = $self->all_X($field);
7962     next unless scalar(@$all);
7963
7964     my %match = ();
7965     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
7966
7967     my @fcust = ();
7968     foreach ( keys %match ) {
7969       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
7970       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
7971     }
7972     my %fsaw = ();
7973     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
7974   }
7975
7976   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
7977   my %saw = ();
7978   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
7979
7980   @cust_main;
7981
7982 }
7983
7984 =item masked FIELD
7985
7986 Returns a masked version of the named field
7987
7988 =cut
7989
7990 sub masked {
7991 my ($self,$field) = @_;
7992
7993 # Show last four
7994
7995 'x'x(length($self->getfield($field))-4).
7996   substr($self->getfield($field), (length($self->getfield($field))-4));
7997
7998 }
7999
8000 =back
8001
8002 =head1 SUBROUTINES
8003
8004 =over 4
8005
8006 =item smart_search OPTION => VALUE ...
8007
8008 Accepts the following options: I<search>, the string to search for.  The string
8009 will be searched for as a customer number, phone number, name or company name,
8010 as an exact, or, in some cases, a substring or fuzzy match (see the source code
8011 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
8012 skip fuzzy matching when an exact match is found.
8013
8014 Any additional options are treated as an additional qualifier on the search
8015 (i.e. I<agentnum>).
8016
8017 Returns a (possibly empty) array of FS::cust_main objects.
8018
8019 =cut
8020
8021 sub smart_search {
8022   my %options = @_;
8023
8024   #here is the agent virtualization
8025   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8026
8027   my @cust_main = ();
8028
8029   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
8030   my $search = delete $options{'search'};
8031   ( my $alphanum_search = $search ) =~ s/\W//g;
8032
8033   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
8034
8035     #false laziness w/Record::ut_phone
8036     my $phonen = "$1-$2-$3";
8037     $phonen .= " x$4" if $4;
8038
8039     push @cust_main, qsearch( {
8040       'table'   => 'cust_main',
8041       'hashref' => { %options },
8042       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8043                      ' ( '.
8044                          join(' OR ', map "$_ = '$phonen'",
8045                                           qw( daytime night fax
8046                                               ship_daytime ship_night ship_fax )
8047                              ).
8048                      ' ) '.
8049                      " AND $agentnums_sql", #agent virtualization
8050     } );
8051
8052     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
8053       #try looking for matches with extensions unless one was specified
8054
8055       push @cust_main, qsearch( {
8056         'table'   => 'cust_main',
8057         'hashref' => { %options },
8058         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8059                        ' ( '.
8060                            join(' OR ', map "$_ LIKE '$phonen\%'",
8061                                             qw( daytime night
8062                                                 ship_daytime ship_night )
8063                                ).
8064                        ' ) '.
8065                        " AND $agentnums_sql", #agent virtualization
8066       } );
8067
8068     }
8069
8070   # custnum search (also try agent_custid), with some tweaking options if your
8071   # legacy cust "numbers" have letters
8072   }
8073
8074   if ( $search =~ /^\s*(\d+)\s*$/
8075          || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
8076               && $search =~ /^\s*(\w\w?\d+)\s*$/
8077             )
8078          || ( $conf->exists('address1-search' )
8079               && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
8080             )
8081      )
8082   {
8083
8084     my $num = $1;
8085
8086     if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
8087       push @cust_main, qsearch( {
8088         'table'     => 'cust_main',
8089         'hashref'   => { 'custnum' => $num, %options },
8090         'extra_sql' => " AND $agentnums_sql", #agent virtualization
8091       } );
8092     }
8093
8094     push @cust_main, qsearch( {
8095       'table'     => 'cust_main',
8096       'hashref'   => { 'agent_custid' => $num, %options },
8097       'extra_sql' => " AND $agentnums_sql", #agent virtualization
8098     } );
8099
8100     if ( $conf->exists('address1-search') ) {
8101       my $len = length($num);
8102       $num = lc($num);
8103       foreach my $prefix ( '', 'ship_' ) {
8104         push @cust_main, qsearch( {
8105           'table'     => 'cust_main',
8106           'hashref'   => { %options, },
8107           'extra_sql' =>
8108             ( keys(%options) ? ' AND ' : ' WHERE ' ).
8109             " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ".
8110             " AND $agentnums_sql",
8111         } );
8112       }
8113     }
8114
8115   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
8116
8117     my($company, $last, $first) = ( $1, $2, $3 );
8118
8119     # "Company (Last, First)"
8120     #this is probably something a browser remembered,
8121     #so just do an exact search (but case-insensitive, so USPS standardization
8122     #doesn't throw a wrench in the works)
8123
8124     foreach my $prefix ( '', 'ship_' ) {
8125       push @cust_main, qsearch( {
8126         'table'     => 'cust_main',
8127         'hashref'   => { %options },
8128         'extra_sql' =>
8129           ( keys(%options) ? ' AND ' : ' WHERE ' ).
8130           join(' AND ',
8131             " LOWER(${prefix}first)   = ". dbh->quote(lc($first)),
8132             " LOWER(${prefix}last)    = ". dbh->quote(lc($last)),
8133             " LOWER(${prefix}company) = ". dbh->quote(lc($company)),
8134             $agentnums_sql,
8135           ),
8136       } );
8137     }
8138
8139   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
8140                                               # try (ship_){last,company}
8141
8142     my $value = lc($1);
8143
8144     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
8145     # # full strings the browser remembers won't work
8146     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
8147
8148     use Lingua::EN::NameParse;
8149     my $NameParse = new Lingua::EN::NameParse(
8150              auto_clean     => 1,
8151              allow_reversed => 1,
8152     );
8153
8154     my($last, $first) = ( '', '' );
8155     #maybe disable this too and just rely on NameParse?
8156     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
8157
8158       ($last, $first) = ( $1, $2 );
8159
8160     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
8161     } elsif ( ! $NameParse->parse($value) ) {
8162
8163       my %name = $NameParse->components;
8164       $first = $name{'given_name_1'};
8165       $last  = $name{'surname_1'};
8166
8167     }
8168
8169     if ( $first && $last ) {
8170
8171       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
8172
8173       #exact
8174       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8175       $sql .= "
8176         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
8177            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
8178         )";
8179
8180       push @cust_main, qsearch( {
8181         'table'     => 'cust_main',
8182         'hashref'   => \%options,
8183         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8184       } );
8185
8186       # or it just be something that was typed in... (try that in a sec)
8187
8188     }
8189
8190     my $q_value = dbh->quote($value);
8191
8192     #exact
8193     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8194     $sql .= " (    LOWER(last)          = $q_value
8195                 OR LOWER(company)       = $q_value
8196                 OR LOWER(ship_last)     = $q_value
8197                 OR LOWER(ship_company)  = $q_value
8198             ";
8199     $sql .= "   OR LOWER(address1)      = $q_value
8200                 OR LOWER(ship_address1) = $q_value
8201             "
8202       if $conf->exists('address1-search');
8203     $sql .= " )";
8204
8205     push @cust_main, qsearch( {
8206       'table'     => 'cust_main',
8207       'hashref'   => \%options,
8208       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8209     } );
8210
8211     #no exact match, trying substring/fuzzy
8212     #always do substring & fuzzy (unless they're explicity config'ed off)
8213     #getting complaints searches are not returning enough
8214     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8215
8216       #still some false laziness w/search (was search/cust_main.cgi)
8217
8218       #substring
8219
8220       my @hashrefs = (
8221         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
8222         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
8223       );
8224
8225       if ( $first && $last ) {
8226
8227         push @hashrefs,
8228           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
8229             'last'         => { op=>'ILIKE', value=>"%$last%" },
8230           },
8231           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
8232             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
8233           },
8234         ;
8235
8236       } else {
8237
8238         push @hashrefs,
8239           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
8240           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
8241         ;
8242       }
8243
8244       if ( $conf->exists('address1-search') ) {
8245         push @hashrefs,
8246           { 'address1'      => { op=>'ILIKE', value=>"%$value%" }, },
8247           { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, },
8248         ;
8249       }
8250
8251       foreach my $hashref ( @hashrefs ) {
8252
8253         push @cust_main, qsearch( {
8254           'table'     => 'cust_main',
8255           'hashref'   => { %$hashref,
8256                            %options,
8257                          },
8258           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
8259         } );
8260
8261       }
8262
8263       #fuzzy
8264       my @fuzopts = (
8265         \%options,                #hashref
8266         '',                       #select
8267         " AND $agentnums_sql",    #extra_sql  #agent virtualization
8268       );
8269
8270       if ( $first && $last ) {
8271         push @cust_main, FS::cust_main->fuzzy_search(
8272           { 'last'   => $last,    #fuzzy hashref
8273             'first'  => $first }, #
8274           @fuzopts
8275         );
8276       }
8277       foreach my $field ( 'last', 'company' ) {
8278         push @cust_main,
8279           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
8280       }
8281       if ( $conf->exists('address1-search') ) {
8282         push @cust_main,
8283           FS::cust_main->fuzzy_search( { 'address1' => $value }, @fuzopts );
8284       }
8285
8286     }
8287
8288   }
8289
8290   #eliminate duplicates
8291   my %saw = ();
8292   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8293
8294   @cust_main;
8295
8296 }
8297
8298 =item email_search
8299
8300 Accepts the following options: I<email>, the email address to search for.  The
8301 email address will be searched for as an email invoice destination and as an
8302 svc_acct account.
8303
8304 #Any additional options are treated as an additional qualifier on the search
8305 #(i.e. I<agentnum>).
8306
8307 Returns a (possibly empty) array of FS::cust_main objects (but usually just
8308 none or one).
8309
8310 =cut
8311
8312 sub email_search {
8313   my %options = @_;
8314
8315   local($DEBUG) = 1;
8316
8317   my $email = delete $options{'email'};
8318
8319   #we're only being used by RT at the moment... no agent virtualization yet
8320   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8321
8322   my @cust_main = ();
8323
8324   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
8325
8326     my ( $user, $domain ) = ( $1, $2 );
8327
8328     warn "$me smart_search: searching for $user in domain $domain"
8329       if $DEBUG;
8330
8331     push @cust_main,
8332       map $_->cust_main,
8333           qsearch( {
8334                      'table'     => 'cust_main_invoice',
8335                      'hashref'   => { 'dest' => $email },
8336                    }
8337                  );
8338
8339     push @cust_main,
8340       map  $_->cust_main,
8341       grep $_,
8342       map  $_->cust_svc->cust_pkg,
8343           qsearch( {
8344                      'table'     => 'svc_acct',
8345                      'hashref'   => { 'username' => $user, },
8346                      'extra_sql' =>
8347                        'AND ( SELECT domain FROM svc_domain
8348                                 WHERE svc_acct.domsvc = svc_domain.svcnum
8349                             ) = '. dbh->quote($domain),
8350                    }
8351                  );
8352   }
8353
8354   my %saw = ();
8355   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8356
8357   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8358     if $DEBUG;
8359
8360   @cust_main;
8361
8362 }
8363
8364 =item check_and_rebuild_fuzzyfiles
8365
8366 =cut
8367
8368 sub check_and_rebuild_fuzzyfiles {
8369   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8370   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8371 }
8372
8373 =item rebuild_fuzzyfiles
8374
8375 =cut
8376
8377 sub rebuild_fuzzyfiles {
8378
8379   use Fcntl qw(:flock);
8380
8381   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8382   mkdir $dir, 0700 unless -d $dir;
8383
8384   foreach my $fuzzy ( @fuzzyfields ) {
8385
8386     open(LOCK,">>$dir/cust_main.$fuzzy")
8387       or die "can't open $dir/cust_main.$fuzzy: $!";
8388     flock(LOCK,LOCK_EX)
8389       or die "can't lock $dir/cust_main.$fuzzy: $!";
8390
8391     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8392       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8393
8394     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8395       my $sth = dbh->prepare("SELECT $field FROM cust_main".
8396                              " WHERE $field != '' AND $field IS NOT NULL");
8397       $sth->execute or die $sth->errstr;
8398
8399       while ( my $row = $sth->fetchrow_arrayref ) {
8400         print CACHE $row->[0]. "\n";
8401       }
8402
8403     }
8404
8405     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8406
8407     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8408     close LOCK;
8409   }
8410
8411 }
8412
8413 =item all_X
8414
8415 =cut
8416
8417 sub all_X {
8418   my( $self, $field ) = @_;
8419   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8420   open(CACHE,"<$dir/cust_main.$field")
8421     or die "can't open $dir/cust_main.$field: $!";
8422   my @array = map { chomp; $_; } <CACHE>;
8423   close CACHE;
8424   \@array;
8425 }
8426
8427 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
8428
8429 =cut
8430
8431 sub append_fuzzyfiles {
8432   #my( $first, $last, $company ) = @_;
8433
8434   &check_and_rebuild_fuzzyfiles;
8435
8436   use Fcntl qw(:flock);
8437
8438   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8439
8440   foreach my $field (@fuzzyfields) {
8441     my $value = shift;
8442
8443     if ( $value ) {
8444
8445       open(CACHE,">>$dir/cust_main.$field")
8446         or die "can't open $dir/cust_main.$field: $!";
8447       flock(CACHE,LOCK_EX)
8448         or die "can't lock $dir/cust_main.$field: $!";
8449
8450       print CACHE "$value\n";
8451
8452       flock(CACHE,LOCK_UN)
8453         or die "can't unlock $dir/cust_main.$field: $!";
8454       close CACHE;
8455     }
8456
8457   }
8458
8459   1;
8460 }
8461
8462 =item batch_charge
8463
8464 =cut
8465
8466 sub batch_charge {
8467   my $param = shift;
8468   #warn join('-',keys %$param);
8469   my $fh = $param->{filehandle};
8470   my @fields = @{$param->{fields}};
8471
8472   eval "use Text::CSV_XS;";
8473   die $@ if $@;
8474
8475   my $csv = new Text::CSV_XS;
8476   #warn $csv;
8477   #warn $fh;
8478
8479   my $imported = 0;
8480   #my $columns;
8481
8482   local $SIG{HUP} = 'IGNORE';
8483   local $SIG{INT} = 'IGNORE';
8484   local $SIG{QUIT} = 'IGNORE';
8485   local $SIG{TERM} = 'IGNORE';
8486   local $SIG{TSTP} = 'IGNORE';
8487   local $SIG{PIPE} = 'IGNORE';
8488
8489   my $oldAutoCommit = $FS::UID::AutoCommit;
8490   local $FS::UID::AutoCommit = 0;
8491   my $dbh = dbh;
8492
8493   #while ( $columns = $csv->getline($fh) ) {
8494   my $line;
8495   while ( defined($line=<$fh>) ) {
8496
8497     $csv->parse($line) or do {
8498       $dbh->rollback if $oldAutoCommit;
8499       return "can't parse: ". $csv->error_input();
8500     };
8501
8502     my @columns = $csv->fields();
8503     #warn join('-',@columns);
8504
8505     my %row = ();
8506     foreach my $field ( @fields ) {
8507       $row{$field} = shift @columns;
8508     }
8509
8510     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
8511     unless ( $cust_main ) {
8512       $dbh->rollback if $oldAutoCommit;
8513       return "unknown custnum $row{'custnum'}";
8514     }
8515
8516     if ( $row{'amount'} > 0 ) {
8517       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
8518       if ( $error ) {
8519         $dbh->rollback if $oldAutoCommit;
8520         return $error;
8521       }
8522       $imported++;
8523     } elsif ( $row{'amount'} < 0 ) {
8524       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
8525                                       $row{'pkg'}                         );
8526       if ( $error ) {
8527         $dbh->rollback if $oldAutoCommit;
8528         return $error;
8529       }
8530       $imported++;
8531     } else {
8532       #hmm?
8533     }
8534
8535   }
8536
8537   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
8538
8539   return "Empty file!" unless $imported;
8540
8541   ''; #no error
8542
8543 }
8544
8545 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8546
8547 Sends a templated email notification to the customer (see L<Text::Template>).
8548
8549 OPTIONS is a hash and may include
8550
8551 I<from> - the email sender (default is invoice_from)
8552
8553 I<to> - comma-separated scalar or arrayref of recipients
8554    (default is invoicing_list)
8555
8556 I<subject> - The subject line of the sent email notification
8557    (default is "Notice from company_name")
8558
8559 I<extra_fields> - a hashref of name/value pairs which will be substituted
8560    into the template
8561
8562 The following variables are vavailable in the template.
8563
8564 I<$first> - the customer first name
8565 I<$last> - the customer last name
8566 I<$company> - the customer company
8567 I<$payby> - a description of the method of payment for the customer
8568             # would be nice to use FS::payby::shortname
8569 I<$payinfo> - the account information used to collect for this customer
8570 I<$expdate> - the expiration of the customer payment in seconds from epoch
8571
8572 =cut
8573
8574 sub notify {
8575   my ($self, $template, %options) = @_;
8576
8577   return unless $conf->exists($template);
8578
8579   my $from = $conf->config('invoice_from', $self->agentnum)
8580     if $conf->exists('invoice_from', $self->agentnum);
8581   $from = $options{from} if exists($options{from});
8582
8583   my $to = join(',', $self->invoicing_list_emailonly);
8584   $to = $options{to} if exists($options{to});
8585
8586   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8587     if $conf->exists('company_name', $self->agentnum);
8588   $subject = $options{subject} if exists($options{subject});
8589
8590   my $notify_template = new Text::Template (TYPE => 'ARRAY',
8591                                             SOURCE => [ map "$_\n",
8592                                               $conf->config($template)]
8593                                            )
8594     or die "can't create new Text::Template object: Text::Template::ERROR";
8595   $notify_template->compile()
8596     or die "can't compile template: Text::Template::ERROR";
8597
8598   $FS::notify_template::_template::company_name =
8599     $conf->config('company_name', $self->agentnum);
8600   $FS::notify_template::_template::company_address =
8601     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
8602
8603   my $paydate = $self->paydate || '2037-12-31';
8604   $FS::notify_template::_template::first = $self->first;
8605   $FS::notify_template::_template::last = $self->last;
8606   $FS::notify_template::_template::company = $self->company;
8607   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
8608   my $payby = $self->payby;
8609   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8610   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8611
8612   #credit cards expire at the end of the month/year of their exp date
8613   if ($payby eq 'CARD' || $payby eq 'DCRD') {
8614     $FS::notify_template::_template::payby = 'credit card';
8615     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8616     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8617     $expire_time--;
8618   }elsif ($payby eq 'COMP') {
8619     $FS::notify_template::_template::payby = 'complimentary account';
8620   }else{
8621     $FS::notify_template::_template::payby = 'current method';
8622   }
8623   $FS::notify_template::_template::expdate = $expire_time;
8624
8625   for (keys %{$options{extra_fields}}){
8626     no strict "refs";
8627     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
8628   }
8629
8630   send_email(from => $from,
8631              to => $to,
8632              subject => $subject,
8633              body => $notify_template->fill_in( PACKAGE =>
8634                                                 'FS::notify_template::_template'                                              ),
8635             );
8636
8637 }
8638
8639 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8640
8641 Generates a templated notification to the customer (see L<Text::Template>).
8642
8643 OPTIONS is a hash and may include
8644
8645 I<extra_fields> - a hashref of name/value pairs which will be substituted
8646    into the template.  These values may override values mentioned below
8647    and those from the customer record.
8648
8649 The following variables are available in the template instead of or in addition
8650 to the fields of the customer record.
8651
8652 I<$payby> - a description of the method of payment for the customer
8653             # would be nice to use FS::payby::shortname
8654 I<$payinfo> - the masked account information used to collect for this customer
8655 I<$expdate> - the expiration of the customer payment method in seconds from epoch
8656 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
8657
8658 =cut
8659
8660 sub generate_letter {
8661   my ($self, $template, %options) = @_;
8662
8663   return unless $conf->exists($template);
8664
8665   my $letter_template = new Text::Template
8666                         ( TYPE       => 'ARRAY',
8667                           SOURCE     => [ map "$_\n", $conf->config($template)],
8668                           DELIMITERS => [ '[@--', '--@]' ],
8669                         )
8670     or die "can't create new Text::Template object: Text::Template::ERROR";
8671
8672   $letter_template->compile()
8673     or die "can't compile template: Text::Template::ERROR";
8674
8675   my %letter_data = map { $_ => $self->$_ } $self->fields;
8676   $letter_data{payinfo} = $self->mask_payinfo;
8677
8678   #my $paydate = $self->paydate || '2037-12-31';
8679   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
8680
8681   my $payby = $self->payby;
8682   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8683   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8684
8685   #credit cards expire at the end of the month/year of their exp date
8686   if ($payby eq 'CARD' || $payby eq 'DCRD') {
8687     $letter_data{payby} = 'credit card';
8688     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8689     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8690     $expire_time--;
8691   }elsif ($payby eq 'COMP') {
8692     $letter_data{payby} = 'complimentary account';
8693   }else{
8694     $letter_data{payby} = 'current method';
8695   }
8696   $letter_data{expdate} = $expire_time;
8697
8698   for (keys %{$options{extra_fields}}){
8699     $letter_data{$_} = $options{extra_fields}->{$_};
8700   }
8701
8702   unless(exists($letter_data{returnaddress})){
8703     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
8704                                                   $self->agent_template)
8705                      );
8706     if ( length($retadd) ) {
8707       $letter_data{returnaddress} = $retadd;
8708     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
8709       $letter_data{returnaddress} =
8710         join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
8711                           $conf->config('company_address', $self->agentnum)
8712         );
8713     } else {
8714       $letter_data{returnaddress} = '~';
8715     }
8716   }
8717
8718   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
8719
8720   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
8721
8722   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
8723   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
8724                            DIR      => $dir,
8725                            SUFFIX   => '.tex',
8726                            UNLINK   => 0,
8727                          ) or die "can't open temp file: $!\n";
8728
8729   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
8730   close $fh;
8731   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
8732   return $1;
8733 }
8734
8735 =item print_ps TEMPLATE
8736
8737 Returns an postscript letter filled in from TEMPLATE, as a scalar.
8738
8739 =cut
8740
8741 sub print_ps {
8742   my $self = shift;
8743   my $file = $self->generate_letter(@_);
8744   FS::Misc::generate_ps($file);
8745 }
8746
8747 =item print TEMPLATE
8748
8749 Prints the filled in template.
8750
8751 TEMPLATE is the name of a L<Text::Template> to fill in and print.
8752
8753 =cut
8754
8755 sub queueable_print {
8756   my %opt = @_;
8757
8758   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
8759     or die "invalid customer number: " . $opt{custvnum};
8760
8761   my $error = $self->print( $opt{template} );
8762   die $error if $error;
8763 }
8764
8765 sub print {
8766   my ($self, $template) = (shift, shift);
8767   do_print [ $self->print_ps($template) ];
8768 }
8769
8770 #these three subs should just go away once agent stuff is all config overrides
8771
8772 sub agent_template {
8773   my $self = shift;
8774   $self->_agent_plandata('agent_templatename');
8775 }
8776
8777 sub agent_invoice_from {
8778   my $self = shift;
8779   $self->_agent_plandata('agent_invoice_from');
8780 }
8781
8782 sub _agent_plandata {
8783   my( $self, $option ) = @_;
8784
8785   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
8786   #agent-specific Conf
8787
8788   use FS::part_event::Condition;
8789
8790   my $agentnum = $self->agentnum;
8791
8792   my $regexp = regexp_sql();
8793
8794   my $part_event_option =
8795     qsearchs({
8796       'select'    => 'part_event_option.*',
8797       'table'     => 'part_event_option',
8798       'addl_from' => q{
8799         LEFT JOIN part_event USING ( eventpart )
8800         LEFT JOIN part_event_option AS peo_agentnum
8801           ON ( part_event.eventpart = peo_agentnum.eventpart
8802                AND peo_agentnum.optionname = 'agentnum'
8803                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
8804              )
8805         LEFT JOIN part_event_condition
8806           ON ( part_event.eventpart = part_event_condition.eventpart
8807                AND part_event_condition.conditionname = 'cust_bill_age'
8808              )
8809         LEFT JOIN part_event_condition_option
8810           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
8811                AND part_event_condition_option.optionname = 'age'
8812              )
8813       },
8814       #'hashref'   => { 'optionname' => $option },
8815       #'hashref'   => { 'part_event_option.optionname' => $option },
8816       'extra_sql' =>
8817         " WHERE part_event_option.optionname = ". dbh->quote($option).
8818         " AND action = 'cust_bill_send_agent' ".
8819         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
8820         " AND peo_agentnum.optionname = 'agentnum' ".
8821         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
8822         " ORDER BY
8823            CASE WHEN part_event_condition_option.optionname IS NULL
8824            THEN -1
8825            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
8826         " END
8827           , part_event.weight".
8828         " LIMIT 1"
8829     });
8830
8831   unless ( $part_event_option ) {
8832     return $self->agent->invoice_template || ''
8833       if $option eq 'agent_templatename';
8834     return '';
8835   }
8836
8837   $part_event_option->optionvalue;
8838
8839 }
8840
8841 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
8842
8843 Subroutine (not a method), designed to be called from the queue.
8844
8845 Takes a list of options and values.
8846
8847 Pulls up the customer record via the custnum option and calls bill_and_collect.
8848
8849 =cut
8850
8851 sub queued_bill {
8852   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
8853
8854   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
8855   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
8856
8857   $cust_main->bill_and_collect( %args );
8858 }
8859
8860 sub _upgrade_data { #class method
8861   my ($class, %opts) = @_;
8862
8863   my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
8864   my $sth = dbh->prepare($sql) or die dbh->errstr;
8865   $sth->execute or die $sth->errstr;
8866
8867   local($ignore_expired_card) = 1;
8868   $class->_upgrade_otaker(%opts);
8869
8870 }
8871
8872 =back
8873
8874 =head1 BUGS
8875
8876 The delete method.
8877
8878 The delete method should possibly take an FS::cust_main object reference
8879 instead of a scalar customer number.
8880
8881 Bill and collect options should probably be passed as references instead of a
8882 list.
8883
8884 There should probably be a configuration file with a list of allowed credit
8885 card types.
8886
8887 No multiple currency support (probably a larger project than just this module).
8888
8889 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
8890
8891 Birthdates rely on negative epoch values.
8892
8893 The payby for card/check batches is broken.  With mixed batching, bad
8894 things will happen.
8895
8896 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
8897
8898 =head1 SEE ALSO
8899
8900 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
8901 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
8902 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
8903
8904 =cut
8905
8906 1;
8907