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