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