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