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