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