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