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