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