FS/FS/cust_main.pm

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