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