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