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