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