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