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