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