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