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