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