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