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