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