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 invocice.  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     $void->content( 'action' => 'void', %content );
4667     $void->submit();
4668     if ( $void->is_success ) {
4669       my $error = $cust_pay->void($options{'reason'});
4670       if ( $error ) {
4671         # gah, even with transactions.
4672         my $e = 'WARNING: Card/ACH voided but database not updated - '.
4673                 "error voiding payment: $error";
4674         warn $e;
4675         return $e;
4676       }
4677       warn "  void successful\n" if $DEBUG > 1;
4678       return '';
4679     }
4680   }
4681
4682   warn "  void unsuccessful, trying refund\n"
4683     if $DEBUG > 1;
4684
4685   #massage data
4686   my $address = $self->address1;
4687   $address .= ", ". $self->address2 if $self->address2;
4688
4689   my($payname, $payfirst, $paylast);
4690   if ( $self->payname && $method ne 'ECHECK' ) {
4691     $payname = $self->payname;
4692     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4693       or return "Illegal payname $payname";
4694     ($payfirst, $paylast) = ($1, $2);
4695   } else {
4696     $payfirst = $self->getfield('first');
4697     $paylast = $self->getfield('last');
4698     $payname =  "$payfirst $paylast";
4699   }
4700
4701   my @invoicing_list = $self->invoicing_list_emailonly;
4702   if ( $conf->exists('emailinvoiceautoalways')
4703        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4704        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4705     push @invoicing_list, $self->all_emails;
4706   }
4707
4708   my $email = ($conf->exists('business-onlinepayment-email-override'))
4709               ? $conf->config('business-onlinepayment-email-override')
4710               : $invoicing_list[0];
4711
4712   my $payip = exists($options{'payip'})
4713                 ? $options{'payip'}
4714                 : $self->payip;
4715   $content{customer_ip} = $payip
4716     if length($payip);
4717
4718   my $payinfo = '';
4719   if ( $method eq 'CC' ) {
4720
4721     if ( $cust_pay ) {
4722       $content{card_number} = $payinfo = $cust_pay->payinfo;
4723       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4724         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4725         ($content{expiration} = "$2/$1");  # where available
4726     } else {
4727       $content{card_number} = $payinfo = $self->payinfo;
4728       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4729         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4730       $content{expiration} = "$2/$1";
4731     }
4732
4733   } elsif ( $method eq 'ECHECK' ) {
4734
4735     if ( $cust_pay ) {
4736       $payinfo = $cust_pay->payinfo;
4737     } else {
4738       $payinfo = $self->payinfo;
4739     }
4740     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4741     $content{bank_name} = $self->payname;
4742     $content{account_type} = 'CHECKING';
4743     $content{account_name} = $payname;
4744     $content{customer_org} = $self->company ? 'B' : 'I';
4745     $content{customer_ssn} = $self->ss;
4746   } elsif ( $method eq 'LEC' ) {
4747     $content{phone} = $payinfo = $self->payinfo;
4748   }
4749
4750   #then try refund
4751   my $refund = new Business::OnlinePayment( $processor, @bop_options );
4752   my %sub_content = $refund->content(
4753     'action'         => 'credit',
4754     'customer_id'    => $self->custnum,
4755     'last_name'      => $paylast,
4756     'first_name'     => $payfirst,
4757     'name'           => $payname,
4758     'address'        => $address,
4759     'city'           => $self->city,
4760     'state'          => $self->state,
4761     'zip'            => $self->zip,
4762     'country'        => $self->country,
4763     'email'          => $email,
4764     'phone'          => $self->daytime || $self->night,
4765     %content, #after
4766   );
4767   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
4768     if $DEBUG > 1;
4769   $refund->submit();
4770
4771   return "$processor error: ". $refund->error_message
4772     unless $refund->is_success();
4773
4774   my %method2payby = (
4775     'CC'     => 'CARD',
4776     'ECHECK' => 'CHEK',
4777     'LEC'    => 'LECB',
4778   );
4779
4780   my $paybatch = "$processor:". $refund->authorization;
4781   $paybatch .= ':'. $refund->order_number
4782     if $refund->can('order_number') && $refund->order_number;
4783
4784   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4785     my @cust_bill_pay = $cust_pay->cust_bill_pay;
4786     last unless @cust_bill_pay;
4787     my $cust_bill_pay = pop @cust_bill_pay;
4788     my $error = $cust_bill_pay->delete;
4789     last if $error;
4790   }
4791
4792   my $cust_refund = new FS::cust_refund ( {
4793     'custnum'  => $self->custnum,
4794     'paynum'   => $options{'paynum'},
4795     'refund'   => $amount,
4796     '_date'    => '',
4797     'payby'    => $method2payby{$method},
4798     'payinfo'  => $payinfo,
4799     'paybatch' => $paybatch,
4800     'reason'   => $options{'reason'} || 'card or ACH refund',
4801   } );
4802   my $error = $cust_refund->insert;
4803   if ( $error ) {
4804     $cust_refund->paynum(''); #try again with no specific paynum
4805     my $error2 = $cust_refund->insert;
4806     if ( $error2 ) {
4807       # gah, even with transactions.
4808       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4809               "error inserting refund ($processor): $error2".
4810               " (previously tried insert with paynum #$options{'paynum'}" .
4811               ": $error )";
4812       warn $e;
4813       return $e;
4814     }
4815   }
4816
4817   ''; #no error
4818
4819 }
4820
4821 # does the configuration indicate the new bop routines are required?
4822
4823 sub _new_bop_required {
4824   my $self = shift;
4825
4826   my $botpp = 'Business::OnlineThirdPartyPayment';
4827
4828   return 1
4829     if ( $conf->config('business-onlinepayment-namespace') eq $botpp ||
4830          scalar( grep { $_->gateway_namespace eq $botpp }
4831                  qsearch( 'payment_gateway', { 'disabled' => '' } )
4832                )
4833        )
4834   ;
4835
4836   '';
4837 }
4838
4839 =item realtime_collect [ OPTION => VALUE ... ]
4840
4841 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4842 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4843 gateway.  See L<http://420.am/business-onlinepayment> and
4844 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4845
4846 On failure returns an error message.
4847
4848 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.
4849
4850 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum>
4851
4852 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>.  If none is specified
4853 then it is deduced from the customer record.
4854
4855 If no I<amount> is specified, then the customer balance is used.
4856
4857 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4858 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4859 if set, will override the value from the customer record.
4860
4861 I<description> is a free-text field passed to the gateway.  It defaults to
4862 the value defined by the business-onlinepayment-description configuration
4863 option, or "Internet services" if that is unset.
4864
4865 If an I<invnum> is specified, this payment (if successful) is applied to the
4866 specified invoice.  If you don't specify an I<invnum> you might want to
4867 call the B<apply_payments> method or set the I<apply> option.
4868
4869 I<apply> can be set to true to apply a resulting payment.
4870
4871 I<quiet> can be set true to surpress email decline notices.
4872
4873 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
4874 resulting paynum, if any.
4875
4876 I<payunique> is a unique identifier for this payment.
4877
4878 I<session_id> is a session identifier associated with this payment.
4879
4880 I<depend_jobnum> allows payment capture to unlock export jobs
4881
4882 =cut
4883
4884 sub realtime_collect {
4885   my( $self, %options ) = @_;
4886
4887   if ( $DEBUG ) {
4888     warn "$me realtime_collect:\n";
4889     warn "  $_ => $options{$_}\n" foreach keys %options;
4890   }
4891
4892   $options{amount} = $self->balance unless exists( $options{amount} );
4893   $options{method} = FS::payby->payby2bop($self->payby)
4894     unless exists( $options{method} );
4895
4896   return $self->realtime_bop({%options});
4897
4898 }
4899
4900 =item _realtime_bop { [ ARG => VALUE ... ] }
4901
4902 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4903 via a Business::OnlinePayment realtime gateway.  See
4904 L<http://420.am/business-onlinepayment> for supported gateways.
4905
4906 Required arguments in the hashref are I<method>, and I<amount>
4907
4908 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4909
4910 Available optional arguments are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4911
4912 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4913 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4914 if set, will override the value from the customer record.
4915
4916 I<description> is a free-text field passed to the gateway.  It defaults to
4917 the value defined by the business-onlinepayment-description configuration
4918 option, or "Internet services" if that is unset.
4919
4920 If an I<invnum> is specified, this payment (if successful) is applied to the
4921 specified invoice.  If you don't specify an I<invnum> you might want to
4922 call the B<apply_payments> method.
4923
4924 I<quiet> can be set true to surpress email decline notices.
4925
4926 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
4927 resulting paynum, if any.
4928
4929 I<payunique> is a unique identifier for this payment.
4930
4931 I<session_id> is a session identifier associated with this payment.
4932
4933 I<depend_jobnum> allows payment capture to unlock export jobs
4934
4935 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4936
4937 =cut
4938
4939 # some helper routines
4940 sub _payment_gateway {
4941   my ($self, $options) = @_;
4942
4943   $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4944     unless exists($options->{payment_gateway});
4945
4946   $options->{payment_gateway};
4947 }
4948
4949 sub _bop_auth {
4950   my ($self, $options) = @_;
4951
4952   (
4953     'login'    => $options->{payment_gateway}->gateway_username,
4954     'password' => $options->{payment_gateway}->gateway_password,
4955   );
4956 }
4957
4958 sub _bop_options {
4959   my ($self, $options) = @_;
4960
4961   $options->{payment_gateway}->gatewaynum
4962     ? $options->{payment_gateway}->options
4963     : @{ $options->{payment_gateway}->get('options') };
4964 }
4965
4966 sub _bop_defaults {
4967   my ($self, $options) = @_;
4968
4969   unless ( $options->{'description'} ) {
4970     if ( $conf->exists('business-onlinepayment-description') ) {
4971       my $dtempl = $conf->config('business-onlinepayment-description');
4972
4973       my $agent = $self->agent->agent;
4974       #$pkgs... not here
4975       $options->{'description'} = eval qq("$dtempl");
4976     } else {
4977       $options->{'description'} = 'Internet services';
4978     }
4979   }
4980
4981   $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4982   $options->{invnum} ||= '';
4983   $options->{payname} = $self->payname unless exists( $options->{payname} );
4984 }
4985
4986 sub _bop_content {
4987   my ($self, $options) = @_;
4988   my %content = ();
4989
4990   $content{address} = exists($options->{'address1'})
4991                         ? $options->{'address1'}
4992                         : $self->address1;
4993   my $address2 = exists($options->{'address2'})
4994                    ? $options->{'address2'}
4995                    : $self->address2;
4996   $content{address} .= ", ". $address2 if length($address2);
4997
4998   my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
4999   $content{customer_ip} = $payip if length($payip);
5000
5001   $content{invoice_number} = $options->{'invnum'}
5002     if exists($options->{'invnum'}) && length($options->{'invnum'});
5003
5004   $content{email_customer} =
5005     (    $conf->exists('business-onlinepayment-email_customer')
5006       || $conf->exists('business-onlinepayment-email-override') );
5007
5008   $content{payfirst} = $self->getfield('first');
5009   $content{paylast} = $self->getfield('last');
5010
5011   $content{account_name} = "$content{payfirst} $content{paylast}"
5012     if $options->{method} eq 'ECHECK';
5013
5014   $content{name} = $options->{payname};
5015   $content{name} = $content{account_name} if exists($content{account_name});
5016
5017   $content{city} = exists($options->{city})
5018                      ? $options->{city}
5019                      : $self->city;
5020   $content{state} = exists($options->{state})
5021                       ? $options->{state}
5022                       : $self->state;
5023   $content{zip} = exists($options->{zip})
5024                     ? $options->{'zip'}
5025                     : $self->zip;
5026   $content{country} = exists($options->{country})
5027                         ? $options->{country}
5028                         : $self->country;
5029   $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
5030   $content{phone} = $self->daytime || $self->night;
5031
5032   (%content);
5033 }
5034
5035 my %bop_method2payby = (
5036   'CC'     => 'CARD',
5037   'ECHECK' => 'CHEK',
5038   'LEC'    => 'LECB',
5039 );
5040
5041 sub _new_realtime_bop {
5042   my $self = shift;
5043
5044   my %options = ();
5045   if (ref($_[0]) eq 'HASH') {
5046     %options = %{$_[0]};
5047   } else {
5048     my ( $method, $amount ) = ( shift, shift );
5049     %options = @_;
5050     $options{method} = $method;
5051     $options{amount} = $amount;
5052   }
5053
5054   if ( $DEBUG ) {
5055     warn "$me realtime_bop (new): $options{method} $options{amount}\n";
5056     warn "  $_ => $options{$_}\n" foreach keys %options;
5057   }
5058
5059   return $self->fake_bop(%options) if $options{'fake'};
5060
5061   $self->_bop_defaults(\%options);
5062
5063   ###
5064   # set trans_is_recur based on invnum if there is one
5065   ###
5066
5067   my $trans_is_recur = 0;
5068   if ( $options{'invnum'} ) {
5069
5070     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
5071     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
5072
5073     my @part_pkg =
5074       map  { $_->part_pkg }
5075       grep { $_ }
5076       map  { $_->cust_pkg }
5077       $cust_bill->cust_bill_pkg;
5078
5079     $trans_is_recur = 1
5080       if grep { $_->freq ne '0' } @part_pkg;
5081
5082   }
5083
5084   ###
5085   # select a gateway
5086   ###
5087
5088   my $payment_gateway =  $self->_payment_gateway( \%options );
5089   my $namespace = $payment_gateway->gateway_namespace;
5090
5091   eval "use $namespace";
5092   die $@ if $@;
5093
5094   ###
5095   # check for banned credit card/ACH
5096   ###
5097
5098   my $ban = qsearchs('banned_pay', {
5099     'payby'   => $bop_method2payby{$options{method}},
5100     'payinfo' => md5_base64($options{payinfo}),
5101   } );
5102   return "Banned credit card" if $ban;
5103
5104   ###
5105   # massage data
5106   ###
5107
5108   my (%bop_content) = $self->_bop_content(\%options);
5109
5110   if ( $options{method} ne 'ECHECK' ) {
5111     $options{payname} =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5112       or return "Illegal payname $options{payname}";
5113     ($bop_content{payfirst}, $bop_content{paylast}) = ($1, $2);
5114   }
5115
5116   my @invoicing_list = $self->invoicing_list_emailonly;
5117   if ( $conf->exists('emailinvoiceautoalways')
5118        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5119        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5120     push @invoicing_list, $self->all_emails;
5121   }
5122
5123   my $email = ($conf->exists('business-onlinepayment-email-override'))
5124               ? $conf->config('business-onlinepayment-email-override')
5125               : $invoicing_list[0];
5126
5127   my $paydate = '';
5128   my %content = ();
5129   if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
5130
5131     $content{card_number} = $options{payinfo};
5132     $paydate = exists($options{'paydate'})
5133                     ? $options{'paydate'}
5134                     : $self->paydate;
5135     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5136     $content{expiration} = "$2/$1";
5137
5138     my $paycvv = exists($options{'paycvv'})
5139                    ? $options{'paycvv'}
5140                    : $self->paycvv;
5141     $content{cvv2} = $paycvv
5142       if length($paycvv);
5143
5144     my $paystart_month = exists($options{'paystart_month'})
5145                            ? $options{'paystart_month'}
5146                            : $self->paystart_month;
5147
5148     my $paystart_year  = exists($options{'paystart_year'})
5149                            ? $options{'paystart_year'}
5150                            : $self->paystart_year;
5151
5152     $content{card_start} = "$paystart_month/$paystart_year"
5153       if $paystart_month && $paystart_year;
5154
5155     my $payissue       = exists($options{'payissue'})
5156                            ? $options{'payissue'}
5157                            : $self->payissue;
5158     $content{issue_number} = $payissue if $payissue;
5159
5160     if ( $self->_bop_recurring_billing( 'payinfo'        => $options{'payinfo'},
5161                                         'trans_is_recur' => $trans_is_recur,
5162                                       )
5163        )
5164     {
5165       $content{recurring_billing} = 'YES';
5166       $content{acct_code} = 'rebill'
5167         if $conf->exists('credit_card-recurring_billing_acct_code');
5168     }
5169
5170   } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
5171     ( $content{account_number}, $content{routing_code} ) =
5172       split('@', $options{payinfo});
5173     $content{bank_name} = $options{payname};
5174     $content{bank_state} = exists($options{'paystate'})
5175                              ? $options{'paystate'}
5176                              : $self->getfield('paystate');
5177     $content{account_type} = exists($options{'paytype'})
5178                                ? uc($options{'paytype'}) || 'CHECKING'
5179                                : uc($self->getfield('paytype')) || 'CHECKING';
5180     $content{customer_org} = $self->company ? 'B' : 'I';
5181     $content{state_id}       = exists($options{'stateid'})
5182                                  ? $options{'stateid'}
5183                                  : $self->getfield('stateid');
5184     $content{state_id_state} = exists($options{'stateid_state'})
5185                                  ? $options{'stateid_state'}
5186                                  : $self->getfield('stateid_state');
5187     $content{customer_ssn} = exists($options{'ss'})
5188                                ? $options{'ss'}
5189                                : $self->ss;
5190   } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
5191     $content{phone} = $options{payinfo};
5192   } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
5193     #move along
5194   } else {
5195     #die an evil death
5196   }
5197
5198   ###
5199   # run transaction(s)
5200   ###
5201
5202   my $balance = exists( $options{'balance'} )
5203                   ? $options{'balance'}
5204                   : $self->balance;
5205
5206   $self->select_for_update; #mutex ... just until we get our pending record in
5207
5208   #the checks here are intended to catch concurrent payments
5209   #double-form-submission prevention is taken care of in cust_pay_pending::check
5210
5211   #check the balance
5212   return "The customer's balance has changed; $options{method} transaction aborted."
5213     if $self->balance < $balance;
5214     #&& $self->balance < $options{amount}; #might as well anyway?
5215
5216   #also check and make sure there aren't *other* pending payments for this cust
5217
5218   my @pending = qsearch('cust_pay_pending', {
5219     'custnum' => $self->custnum,
5220     'status'  => { op=>'!=', value=>'done' }
5221   });
5222   return "A payment is already being processed for this customer (".
5223          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
5224          "); $options{method} transaction aborted."
5225     if scalar(@pending);
5226
5227   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
5228
5229   my $cust_pay_pending = new FS::cust_pay_pending {
5230     'custnum'           => $self->custnum,
5231     #'invnum'            => $options{'invnum'},
5232     'paid'              => $options{amount},
5233     '_date'             => '',
5234     'payby'             => $bop_method2payby{$options{method}},
5235     'payinfo'           => $options{payinfo},
5236     'paydate'           => $paydate,
5237     'recurring_billing' => $content{recurring_billing},
5238     'pkgnum'            => $options{'pkgnum'},
5239     'status'            => 'new',
5240     'gatewaynum'        => $payment_gateway->gatewaynum || '',
5241     'session_id'        => $options{session_id} || '',
5242     'jobnum'            => $options{depend_jobnum} || '',
5243   };
5244   $cust_pay_pending->payunique( $options{payunique} )
5245     if defined($options{payunique}) && length($options{payunique});
5246   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
5247   return $cpp_new_err if $cpp_new_err;
5248
5249   my( $action1, $action2 ) =
5250     split( /\s*\,\s*/, $payment_gateway->gateway_action );
5251
5252   my $transaction = new $namespace( $payment_gateway->gateway_module,
5253                                     $self->_bop_options(\%options),
5254                                   );
5255
5256   $transaction->content(
5257     'type'           => $options{method},
5258     $self->_bop_auth(\%options),
5259     'action'         => $action1,
5260     'description'    => $options{'description'},
5261     'amount'         => $options{amount},
5262     #'invoice_number' => $options{'invnum'},
5263     'customer_id'    => $self->custnum,
5264     %bop_content,
5265     'reference'      => $cust_pay_pending->paypendingnum, #for now
5266     'email'          => $email,
5267     %content, #after
5268   );
5269
5270   $cust_pay_pending->status('pending');
5271   my $cpp_pending_err = $cust_pay_pending->replace;
5272   return $cpp_pending_err if $cpp_pending_err;
5273
5274   #config?
5275   my $BOP_TESTING = 0;
5276   my $BOP_TESTING_SUCCESS = 1;
5277
5278   unless ( $BOP_TESTING ) {
5279     $transaction->submit();
5280   } else {
5281     if ( $BOP_TESTING_SUCCESS ) {
5282       $transaction->is_success(1);
5283       $transaction->authorization('fake auth');
5284     } else {
5285       $transaction->is_success(0);
5286       $transaction->error_message('fake failure');
5287     }
5288   }
5289
5290   if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
5291
5292     return { reference => $cust_pay_pending->paypendingnum,
5293              map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
5294
5295   } elsif ( $transaction->is_success() && $action2 ) {
5296
5297     $cust_pay_pending->status('authorized');
5298     my $cpp_authorized_err = $cust_pay_pending->replace;
5299     return $cpp_authorized_err if $cpp_authorized_err;
5300
5301     my $auth = $transaction->authorization;
5302     my $ordernum = $transaction->can('order_number')
5303                    ? $transaction->order_number
5304                    : '';
5305
5306     my $capture =
5307       new Business::OnlinePayment( $payment_gateway->gateway_module,
5308                                    $self->_bop_options(\%options),
5309                                  );
5310
5311     my %capture = (
5312       %content,
5313       type           => $options{method},
5314       action         => $action2,
5315       $self->_bop_auth(\%options),
5316       order_number   => $ordernum,
5317       amount         => $options{amount},
5318       authorization  => $auth,
5319       description    => $options{'description'},
5320     );
5321
5322     foreach my $field (qw( authorization_source_code returned_ACI
5323                            transaction_identifier validation_code
5324                            transaction_sequence_num local_transaction_date
5325                            local_transaction_time AVS_result_code          )) {
5326       $capture{$field} = $transaction->$field() if $transaction->can($field);
5327     }
5328
5329     $capture->content( %capture );
5330
5331     $capture->submit();
5332
5333     unless ( $capture->is_success ) {
5334       my $e = "Authorization successful but capture failed, custnum #".
5335               $self->custnum. ': '.  $capture->result_code.
5336               ": ". $capture->error_message;
5337       warn $e;
5338       return $e;
5339     }
5340
5341   }
5342
5343   ###
5344   # remove paycvv after initial transaction
5345   ###
5346
5347   #false laziness w/misc/process/payment.cgi - check both to make sure working
5348   # correctly
5349   if ( defined $self->dbdef_table->column('paycvv')
5350        && length($self->paycvv)
5351        && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
5352   ) {
5353     my $error = $self->remove_cvv;
5354     if ( $error ) {
5355       warn "WARNING: error removing cvv: $error\n";
5356     }
5357   }
5358
5359   ###
5360   # result handling
5361   ###
5362
5363   $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5364
5365 }
5366
5367 =item fake_bop
5368
5369 =cut
5370
5371 sub fake_bop {
5372   my $self = shift;
5373
5374   my %options = ();
5375   if (ref($_[0]) eq 'HASH') {
5376     %options = %{$_[0]};
5377   } else {
5378     my ( $method, $amount ) = ( shift, shift );
5379     %options = @_;
5380     $options{method} = $method;
5381     $options{amount} = $amount;
5382   }
5383
5384   if ( $options{'fake_failure'} ) {
5385      return "Error: No error; test failure requested with fake_failure";
5386   }
5387
5388   #my $paybatch = '';
5389   #if ( $payment_gateway->gatewaynum ) { # agent override
5390   #  $paybatch = $payment_gateway->gatewaynum. '-';
5391   #}
5392   #
5393   #$paybatch .= "$processor:". $transaction->authorization;
5394   #
5395   #$paybatch .= ':'. $transaction->order_number
5396   #  if $transaction->can('order_number')
5397   #  && length($transaction->order_number);
5398
5399   my $paybatch = 'FakeProcessor:54:32';
5400
5401   my $cust_pay = new FS::cust_pay ( {
5402      'custnum'  => $self->custnum,
5403      'invnum'   => $options{'invnum'},
5404      'paid'     => $options{amount},
5405      '_date'    => '',
5406      'payby'    => $bop_method2payby{$options{method}},
5407      #'payinfo'  => $payinfo,
5408      'payinfo'  => '4111111111111111',
5409      'paybatch' => $paybatch,
5410      #'paydate'  => $paydate,
5411      'paydate'  => '2012-05-01',
5412   } );
5413   $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
5414
5415   my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5416
5417   if ( $error ) {
5418     $cust_pay->invnum(''); #try again with no specific invnum
5419     my $error2 = $cust_pay->insert( $options{'manual'} ?
5420                                     ( 'manual' => 1 ) : ()
5421                                   );
5422     if ( $error2 ) {
5423       # gah, even with transactions.
5424       my $e = 'WARNING: Card/ACH debited but database not updated - '.
5425               "error inserting (fake!) payment: $error2".
5426               " (previously tried insert with invnum #$options{'invnum'}" .
5427               ": $error )";
5428       warn $e;
5429       return $e;
5430     }
5431   }
5432
5433   if ( $options{'paynum_ref'} ) {
5434     ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5435   }
5436
5437   return ''; #no error
5438
5439 }
5440
5441
5442 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
5443 #
5444 # Wraps up processing of a realtime credit card, ACH (electronic check) or
5445 # phone bill transaction.
5446
5447 sub _realtime_bop_result {
5448   my( $self, $cust_pay_pending, $transaction, %options ) = @_;
5449   if ( $DEBUG ) {
5450     warn "$me _realtime_bop_result: pending transaction ".
5451       $cust_pay_pending->paypendingnum. "\n";
5452     warn "  $_ => $options{$_}\n" foreach keys %options;
5453   }
5454
5455   my $payment_gateway = $options{payment_gateway}
5456     or return "no payment gateway in arguments to _realtime_bop_result";
5457
5458   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5459   my $cpp_captured_err = $cust_pay_pending->replace;
5460   return $cpp_captured_err if $cpp_captured_err;
5461
5462   if ( $transaction->is_success() ) {
5463
5464     my $paybatch = '';
5465     if ( $payment_gateway->gatewaynum ) { # agent override
5466       $paybatch = $payment_gateway->gatewaynum. '-';
5467     }
5468
5469     $paybatch .= $payment_gateway->gateway_module. ":".
5470       $transaction->authorization;
5471
5472     $paybatch .= ':'. $transaction->order_number
5473       if $transaction->can('order_number')
5474       && length($transaction->order_number);
5475
5476     my $cust_pay = new FS::cust_pay ( {
5477        'custnum'  => $self->custnum,
5478        'invnum'   => $options{'invnum'},
5479        'paid'     => $cust_pay_pending->paid,
5480        '_date'    => '',
5481        'payby'    => $cust_pay_pending->payby,
5482        #'payinfo'  => $payinfo,
5483        'paybatch' => $paybatch,
5484        'paydate'  => $cust_pay_pending->paydate,
5485        'pkgnum'   => $cust_pay_pending->pkgnum,
5486     } );
5487     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5488     $cust_pay->payunique( $options{payunique} )
5489       if defined($options{payunique}) && length($options{payunique});
5490
5491     my $oldAutoCommit = $FS::UID::AutoCommit;
5492     local $FS::UID::AutoCommit = 0;
5493     my $dbh = dbh;
5494
5495     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5496
5497     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5498
5499     if ( $error ) {
5500       $cust_pay->invnum(''); #try again with no specific invnum
5501       my $error2 = $cust_pay->insert( $options{'manual'} ?
5502                                       ( 'manual' => 1 ) : ()
5503                                     );
5504       if ( $error2 ) {
5505         # gah.  but at least we have a record of the state we had to abort in
5506         # from cust_pay_pending now.
5507         my $e = "WARNING: $options{method} captured but payment not recorded -".
5508                 " error inserting payment (". $payment_gateway->gateway_module.
5509                 "): $error2".
5510                 " (previously tried insert with invnum #$options{'invnum'}" .
5511                 ": $error ) - pending payment saved as paypendingnum ".
5512                 $cust_pay_pending->paypendingnum. "\n";
5513         warn $e;
5514         return $e;
5515       }
5516     }
5517
5518     my $jobnum = $cust_pay_pending->jobnum;
5519     if ( $jobnum ) {
5520        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5521
5522        unless ( $placeholder ) {
5523          $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5524          my $e = "WARNING: $options{method} captured but job $jobnum not ".
5525              "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5526          warn $e;
5527          return $e;
5528        }
5529
5530        $error = $placeholder->delete;
5531
5532        if ( $error ) {
5533          $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5534          my $e = "WARNING: $options{method} captured but could not delete ".
5535               "job $jobnum for paypendingnum ".
5536               $cust_pay_pending->paypendingnum. ": $error\n";
5537          warn $e;
5538          return $e;
5539        }
5540
5541     }
5542
5543     if ( $options{'paynum_ref'} ) {
5544       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5545     }
5546
5547     $cust_pay_pending->status('done');
5548     $cust_pay_pending->statustext('captured');
5549     $cust_pay_pending->paynum($cust_pay->paynum);
5550     my $cpp_done_err = $cust_pay_pending->replace;
5551
5552     if ( $cpp_done_err ) {
5553
5554       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5555       my $e = "WARNING: $options{method} captured but payment not recorded - ".
5556               "error updating status for paypendingnum ".
5557               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5558       warn $e;
5559       return $e;
5560
5561     } else {
5562
5563       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5564
5565       if ( $options{'apply'} ) {
5566         my $apply_error = $self->apply_payments_and_credits;
5567         if ( $apply_error ) {
5568           warn "WARNING: error applying payment: $apply_error\n";
5569           #but we still should return no error cause the payment otherwise went
5570           #through...
5571         }
5572       }
5573
5574       return ''; #no error
5575
5576     }
5577
5578   } else {
5579
5580     my $perror = $payment_gateway->gateway_module. " error: ".
5581       $transaction->error_message;
5582
5583     my $jobnum = $cust_pay_pending->jobnum;
5584     if ( $jobnum ) {
5585        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5586
5587        if ( $placeholder ) {
5588          my $error = $placeholder->depended_delete;
5589          $error ||= $placeholder->delete;
5590          warn "error removing provisioning jobs after declined paypendingnum ".
5591            $cust_pay_pending->paypendingnum. "\n";
5592        } else {
5593          my $e = "error finding job $jobnum for declined paypendingnum ".
5594               $cust_pay_pending->paypendingnum. "\n";
5595          warn $e;
5596        }
5597
5598     }
5599
5600     unless ( $transaction->error_message ) {
5601
5602       my $t_response;
5603       if ( $transaction->can('response_page') ) {
5604         $t_response = {
5605                         'page'    => ( $transaction->can('response_page')
5606                                          ? $transaction->response_page
5607                                          : ''
5608                                      ),
5609                         'code'    => ( $transaction->can('response_code')
5610                                          ? $transaction->response_code
5611                                          : ''
5612                                      ),
5613                         'headers' => ( $transaction->can('response_headers')
5614                                          ? $transaction->response_headers
5615                                          : ''
5616                                      ),
5617                       };
5618       } else {
5619         $t_response .=
5620           "No additional debugging information available for ".
5621             $payment_gateway->gateway_module;
5622       }
5623
5624       $perror .= "No error_message returned from ".
5625                    $payment_gateway->gateway_module. " -- ".
5626                  ( ref($t_response) ? Dumper($t_response) : $t_response );
5627
5628     }
5629
5630     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5631          && $conf->exists('emaildecline')
5632          && grep { $_ ne 'POST' } $self->invoicing_list
5633          && ! grep { $transaction->error_message =~ /$_/ }
5634                    $conf->config('emaildecline-exclude')
5635     ) {
5636       my @templ = $conf->config('declinetemplate');
5637       my $template = new Text::Template (
5638         TYPE   => 'ARRAY',
5639         SOURCE => [ map "$_\n", @templ ],
5640       ) or return "($perror) can't create template: $Text::Template::ERROR";
5641       $template->compile()
5642         or return "($perror) can't compile template: $Text::Template::ERROR";
5643
5644       my $templ_hash = {
5645         'company_name'    =>
5646           scalar( $conf->config('company_name', $self->agentnum ) ),
5647         'company_address' =>
5648           join("\n", $conf->config('company_address', $self->agentnum ) ),
5649         'error'           => $transaction->error_message,
5650       };
5651
5652       my $error = send_email(
5653         'from'    => $conf->config('invoice_from', $self->agentnum ),
5654         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5655         'subject' => 'Your payment could not be processed',
5656         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
5657       );
5658
5659       $perror .= " (also received error sending decline notification: $error)"
5660         if $error;
5661
5662     }
5663
5664     $cust_pay_pending->status('done');
5665     $cust_pay_pending->statustext("declined: $perror");
5666     my $cpp_done_err = $cust_pay_pending->replace;
5667     if ( $cpp_done_err ) {
5668       my $e = "WARNING: $options{method} declined but pending payment not ".
5669               "resolved - error updating status for paypendingnum ".
5670               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5671       warn $e;
5672       $perror = "$e ($perror)";
5673     }
5674
5675     return $perror;
5676   }
5677
5678 }
5679
5680 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5681
5682 Verifies successful third party processing of a realtime credit card,
5683 ACH (electronic check) or phone bill transaction via a
5684 Business::OnlineThirdPartyPayment realtime gateway.  See
5685 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5686
5687 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5688
5689 The additional options I<payname>, I<city>, I<state>,
5690 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
5691 if set, will override the value from the customer record.
5692
5693 I<description> is a free-text field passed to the gateway.  It defaults to
5694 "Internet services".
5695
5696 If an I<invnum> is specified, this payment (if successful) is applied to the
5697 specified invoice.  If you don't specify an I<invnum> you might want to
5698 call the B<apply_payments> method.
5699
5700 I<quiet> can be set true to surpress email decline notices.
5701
5702 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
5703 resulting paynum, if any.
5704
5705 I<payunique> is a unique identifier for this payment.
5706
5707 Returns a hashref containing elements bill_error (which will be undefined
5708 upon success) and session_id of any associated session.
5709
5710 =cut
5711
5712 sub realtime_botpp_capture {
5713   my( $self, $cust_pay_pending, %options ) = @_;
5714   if ( $DEBUG ) {
5715     warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5716     warn "  $_ => $options{$_}\n" foreach keys %options;
5717   }
5718
5719   eval "use Business::OnlineThirdPartyPayment";
5720   die $@ if $@;
5721
5722   ###
5723   # select the gateway
5724   ###
5725
5726   my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5727
5728   my $payment_gateway = $cust_pay_pending->gatewaynum
5729     ? qsearchs( 'payment_gateway',
5730                 { gatewaynum => $cust_pay_pending->gatewaynum }
5731               )
5732     : $self->agent->payment_gateway( 'method' => $method,
5733                                      # 'invnum'  => $cust_pay_pending->invnum,
5734                                      # 'payinfo' => $cust_pay_pending->payinfo,
5735                                    );
5736
5737   $options{payment_gateway} = $payment_gateway; # for the helper subs
5738
5739   ###
5740   # massage data
5741   ###
5742
5743   my @invoicing_list = $self->invoicing_list_emailonly;
5744   if ( $conf->exists('emailinvoiceautoalways')
5745        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5746        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5747     push @invoicing_list, $self->all_emails;
5748   }
5749
5750   my $email = ($conf->exists('business-onlinepayment-email-override'))
5751               ? $conf->config('business-onlinepayment-email-override')
5752               : $invoicing_list[0];
5753
5754   my %content = ();
5755
5756   $content{email_customer} =
5757     (    $conf->exists('business-onlinepayment-email_customer')
5758       || $conf->exists('business-onlinepayment-email-override') );
5759
5760   ###
5761   # run transaction(s)
5762   ###
5763
5764   my $transaction =
5765     new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5766                                            $self->_bop_options(\%options),
5767                                          );
5768
5769   $transaction->reference({ %options });
5770
5771   $transaction->content(
5772     'type'           => $method,
5773     $self->_bop_auth(\%options),
5774     'action'         => 'Post Authorization',
5775     'description'    => $options{'description'},
5776     'amount'         => $cust_pay_pending->paid,
5777     #'invoice_number' => $options{'invnum'},
5778     'customer_id'    => $self->custnum,
5779     'referer'        => 'http://cleanwhisker.420.am/',
5780     'reference'      => $cust_pay_pending->paypendingnum,
5781     'email'          => $email,
5782     'phone'          => $self->daytime || $self->night,
5783     %content, #after
5784     # plus whatever is required for bogus capture avoidance
5785   );
5786
5787   $transaction->submit();
5788
5789   my $error =
5790     $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5791
5792   {
5793     bill_error => $error,
5794     session_id => $cust_pay_pending->session_id,
5795   }
5796
5797 }
5798
5799 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5800
5801 =cut
5802
5803 sub default_payment_gateway {
5804   my( $self, $method ) = @_;
5805
5806   die "Real-time processing not enabled\n"
5807     unless $conf->exists('business-onlinepayment');
5808
5809   #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5810
5811   #load up config
5812   my $bop_config = 'business-onlinepayment';
5813   $bop_config .= '-ach'
5814     if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5815   my ( $processor, $login, $password, $action, @bop_options ) =
5816     $conf->config($bop_config);
5817   $action ||= 'normal authorization';
5818   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5819   die "No real-time processor is enabled - ".
5820       "did you set the business-onlinepayment configuration value?\n"
5821     unless $processor;
5822
5823   ( $processor, $login, $password, $action, @bop_options )
5824 }
5825
5826 =item remove_cvv
5827
5828 Removes the I<paycvv> field from the database directly.
5829
5830 If there is an error, returns the error, otherwise returns false.
5831
5832 =cut
5833
5834 sub remove_cvv {
5835   my $self = shift;
5836   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5837     or return dbh->errstr;
5838   $sth->execute($self->custnum)
5839     or return $sth->errstr;
5840   $self->paycvv('');
5841   '';
5842 }
5843
5844 =item _new_realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5845
5846 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5847 via a Business::OnlinePayment realtime gateway.  See
5848 L<http://420.am/business-onlinepayment> for supported gateways.
5849
5850 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5851
5852 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5853
5854 Most gateways require a reference to an original payment transaction to refund,
5855 so you probably need to specify a I<paynum>.
5856
5857 I<amount> defaults to the original amount of the payment if not specified.
5858
5859 I<reason> specifies a reason for the refund.
5860
5861 I<paydate> specifies the expiration date for a credit card overriding the
5862 value from the customer record or the payment record. Specified as yyyy-mm-dd
5863
5864 Implementation note: If I<amount> is unspecified or equal to the amount of the
5865 orignal payment, first an attempt is made to "void" the transaction via
5866 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5867 the normal attempt is made to "refund" ("credit") the transaction via the
5868 gateway is attempted.
5869
5870 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5871 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
5872 #if set, will override the value from the customer record.
5873
5874 #If an I<invnum> is specified, this payment (if successful) is applied to the
5875 #specified invoice.  If you don't specify an I<invnum> you might want to
5876 #call the B<apply_payments> method.
5877
5878 =cut
5879
5880 #some false laziness w/realtime_bop, not enough to make it worth merging
5881 #but some useful small subs should be pulled out
5882 sub _new_realtime_refund_bop {
5883   my $self = shift;
5884
5885   my %options = ();
5886   if (ref($_[0]) ne 'HASH') {
5887     %options = %{$_[0]};
5888   } else {
5889     my $method = shift;
5890     %options = @_;
5891     $options{method} = $method;
5892   }
5893
5894   if ( $DEBUG ) {
5895     warn "$me realtime_refund_bop (new): $options{method} refund\n";
5896     warn "  $_ => $options{$_}\n" foreach keys %options;
5897   }
5898
5899   ###
5900   # look up the original payment and optionally a gateway for that payment
5901   ###
5902
5903   my $cust_pay = '';
5904   my $amount = $options{'amount'};
5905
5906   my( $processor, $login, $password, @bop_options, $namespace ) ;
5907   my( $auth, $order_number ) = ( '', '', '' );
5908
5909   if ( $options{'paynum'} ) {
5910
5911     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
5912     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5913       or return "Unknown paynum $options{'paynum'}";
5914     $amount ||= $cust_pay->paid;
5915
5916     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5917       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5918                 $cust_pay->paybatch;
5919     my $gatewaynum = '';
5920     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5921
5922     if ( $gatewaynum ) { #gateway for the payment to be refunded
5923
5924       my $payment_gateway =
5925         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5926       die "payment gateway $gatewaynum not found"
5927         unless $payment_gateway;
5928
5929       $processor   = $payment_gateway->gateway_module;
5930       $login       = $payment_gateway->gateway_username;
5931       $password    = $payment_gateway->gateway_password;
5932       $namespace   = $payment_gateway->gateway_namespace;
5933       @bop_options = $payment_gateway->options;
5934
5935     } else { #try the default gateway
5936
5937       my $conf_processor;
5938       my $payment_gateway =
5939         $self->agent->payment_gateway('method' => $options{method});
5940
5941       ( $conf_processor, $login, $password, $namespace ) =
5942         map { my $method = "gateway_$_"; $payment_gateway->$method }
5943           qw( module username password namespace );
5944
5945       @bop_options = $payment_gateway->gatewaynum
5946                        ? $payment_gateway->options
5947                        : @{ $payment_gateway->get('options') };
5948
5949       return "processor of payment $options{'paynum'} $processor does not".
5950              " match default processor $conf_processor"
5951         unless $processor eq $conf_processor;
5952
5953     }
5954
5955
5956   } else { # didn't specify a paynum, so look for agent gateway overrides
5957            # like a normal transaction
5958
5959     my $payment_gateway =
5960       $self->agent->payment_gateway( 'method'  => $options{method},
5961                                      #'payinfo' => $payinfo,
5962                                    );
5963     my( $processor, $login, $password, $namespace ) =
5964       map { my $method = "gateway_$_"; $payment_gateway->$method }
5965         qw( module username password namespace );
5966
5967     my @bop_options = $payment_gateway->gatewaynum
5968                         ? $payment_gateway->options
5969                         : @{ $payment_gateway->get('options') };
5970
5971   }
5972   return "neither amount nor paynum specified" unless $amount;
5973
5974   eval "use $namespace";
5975   die $@ if $@;
5976
5977   my %content = (
5978     'type'           => $options{method},
5979     'login'          => $login,
5980     'password'       => $password,
5981     'order_number'   => $order_number,
5982     'amount'         => $amount,
5983     'referer'        => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5984   );
5985   $content{authorization} = $auth
5986     if length($auth); #echeck/ACH transactions have an order # but no auth
5987                       #(at least with authorize.net)
5988
5989   my $disable_void_after;
5990   if ($conf->exists('disable_void_after')
5991       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5992     $disable_void_after = $1;
5993   }
5994
5995   #first try void if applicable
5996   if ( $cust_pay && $cust_pay->paid == $amount
5997     && (
5998       ( not defined($disable_void_after) )
5999       || ( time < ($cust_pay->_date + $disable_void_after ) )
6000     )
6001   ) {
6002     warn "  attempting void\n" if $DEBUG > 1;
6003     my $void = new Business::OnlinePayment( $processor, @bop_options );
6004     $void->content( 'action' => 'void', %content );
6005     $void->submit();
6006     if ( $void->is_success ) {
6007       my $error = $cust_pay->void($options{'reason'});
6008       if ( $error ) {
6009         # gah, even with transactions.
6010         my $e = 'WARNING: Card/ACH voided but database not updated - '.
6011                 "error voiding payment: $error";
6012         warn $e;
6013         return $e;
6014       }
6015       warn "  void successful\n" if $DEBUG > 1;
6016       return '';
6017     }
6018   }
6019
6020   warn "  void unsuccessful, trying refund\n"
6021     if $DEBUG > 1;
6022
6023   #massage data
6024   my $address = $self->address1;
6025   $address .= ", ". $self->address2 if $self->address2;
6026
6027   my($payname, $payfirst, $paylast);
6028   if ( $self->payname && $options{method} ne 'ECHECK' ) {
6029     $payname = $self->payname;
6030     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
6031       or return "Illegal payname $payname";
6032     ($payfirst, $paylast) = ($1, $2);
6033   } else {
6034     $payfirst = $self->getfield('first');
6035     $paylast = $self->getfield('last');
6036     $payname =  "$payfirst $paylast";
6037   }
6038
6039   my @invoicing_list = $self->invoicing_list_emailonly;
6040   if ( $conf->exists('emailinvoiceautoalways')
6041        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
6042        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
6043     push @invoicing_list, $self->all_emails;
6044   }
6045
6046   my $email = ($conf->exists('business-onlinepayment-email-override'))
6047               ? $conf->config('business-onlinepayment-email-override')
6048               : $invoicing_list[0];
6049
6050   my $payip = exists($options{'payip'})
6051                 ? $options{'payip'}
6052                 : $self->payip;
6053   $content{customer_ip} = $payip
6054     if length($payip);
6055
6056   my $payinfo = '';
6057   if ( $options{method} eq 'CC' ) {
6058
6059     if ( $cust_pay ) {
6060       $content{card_number} = $payinfo = $cust_pay->payinfo;
6061       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
6062         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
6063         ($content{expiration} = "$2/$1");  # where available
6064     } else {
6065       $content{card_number} = $payinfo = $self->payinfo;
6066       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
6067         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
6068       $content{expiration} = "$2/$1";
6069     }
6070
6071   } elsif ( $options{method} eq 'ECHECK' ) {
6072
6073     if ( $cust_pay ) {
6074       $payinfo = $cust_pay->payinfo;
6075     } else {
6076       $payinfo = $self->payinfo;
6077     }
6078     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
6079     $content{bank_name} = $self->payname;
6080     $content{account_type} = 'CHECKING';
6081     $content{account_name} = $payname;
6082     $content{customer_org} = $self->company ? 'B' : 'I';
6083     $content{customer_ssn} = $self->ss;
6084   } elsif ( $options{method} eq 'LEC' ) {
6085     $content{phone} = $payinfo = $self->payinfo;
6086   }
6087
6088   #then try refund
6089   my $refund = new Business::OnlinePayment( $processor, @bop_options );
6090   my %sub_content = $refund->content(
6091     'action'         => 'credit',
6092     'customer_id'    => $self->custnum,
6093     'last_name'      => $paylast,
6094     'first_name'     => $payfirst,
6095     'name'           => $payname,
6096     'address'        => $address,
6097     'city'           => $self->city,
6098     'state'          => $self->state,
6099     'zip'            => $self->zip,
6100     'country'        => $self->country,
6101     'email'          => $email,
6102     'phone'          => $self->daytime || $self->night,
6103     %content, #after
6104   );
6105   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
6106     if $DEBUG > 1;
6107   $refund->submit();
6108
6109   return "$processor error: ". $refund->error_message
6110     unless $refund->is_success();
6111
6112   my $paybatch = "$processor:". $refund->authorization;
6113   $paybatch .= ':'. $refund->order_number
6114     if $refund->can('order_number') && $refund->order_number;
6115
6116   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
6117     my @cust_bill_pay = $cust_pay->cust_bill_pay;
6118     last unless @cust_bill_pay;
6119     my $cust_bill_pay = pop @cust_bill_pay;
6120     my $error = $cust_bill_pay->delete;
6121     last if $error;
6122   }
6123
6124   my $cust_refund = new FS::cust_refund ( {
6125     'custnum'  => $self->custnum,
6126     'paynum'   => $options{'paynum'},
6127     'refund'   => $amount,
6128     '_date'    => '',
6129     'payby'    => $bop_method2payby{$options{method}},
6130     'payinfo'  => $payinfo,
6131     'paybatch' => $paybatch,
6132     'reason'   => $options{'reason'} || 'card or ACH refund',
6133   } );
6134   my $error = $cust_refund->insert;
6135   if ( $error ) {
6136     $cust_refund->paynum(''); #try again with no specific paynum
6137     my $error2 = $cust_refund->insert;
6138     if ( $error2 ) {
6139       # gah, even with transactions.
6140       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
6141               "error inserting refund ($processor): $error2".
6142               " (previously tried insert with paynum #$options{'paynum'}" .
6143               ": $error )";
6144       warn $e;
6145       return $e;
6146     }
6147   }
6148
6149   ''; #no error
6150
6151 }
6152
6153 =item batch_card OPTION => VALUE...
6154
6155 Adds a payment for this invoice to the pending credit card batch (see
6156 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
6157 runs the payment using a realtime gateway.
6158
6159 =cut
6160
6161 sub batch_card {
6162   my ($self, %options) = @_;
6163
6164   my $amount;
6165   if (exists($options{amount})) {
6166     $amount = $options{amount};
6167   }else{
6168     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
6169   }
6170   return '' unless $amount > 0;
6171
6172   my $invnum = delete $options{invnum};
6173   my $payby = $options{invnum} || $self->payby;  #dubious
6174
6175   if ($options{'realtime'}) {
6176     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
6177                                 $amount,
6178                                 %options,
6179                               );
6180   }
6181
6182   my $oldAutoCommit = $FS::UID::AutoCommit;
6183   local $FS::UID::AutoCommit = 0;
6184   my $dbh = dbh;
6185
6186   #this needs to handle mysql as well as Pg, like svc_acct.pm
6187   #(make it into a common function if folks need to do batching with mysql)
6188   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
6189     or return "Cannot lock pay_batch: " . $dbh->errstr;
6190
6191   my %pay_batch = (
6192     'status' => 'O',
6193     'payby'  => FS::payby->payby2payment($payby),
6194   );
6195
6196   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
6197
6198   unless ( $pay_batch ) {
6199     $pay_batch = new FS::pay_batch \%pay_batch;
6200     my $error = $pay_batch->insert;
6201     if ( $error ) {
6202       $dbh->rollback if $oldAutoCommit;
6203       die "error creating new batch: $error\n";
6204     }
6205   }
6206
6207   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
6208       'batchnum' => $pay_batch->batchnum,
6209       'custnum'  => $self->custnum,
6210   } );
6211
6212   foreach (qw( address1 address2 city state zip country payby payinfo paydate
6213                payname )) {
6214     $options{$_} = '' unless exists($options{$_});
6215   }
6216
6217   my $cust_pay_batch = new FS::cust_pay_batch ( {
6218     'batchnum' => $pay_batch->batchnum,
6219     'invnum'   => $invnum || 0,                    # is there a better value?
6220                                                    # this field should be
6221                                                    # removed...
6222                                                    # cust_bill_pay_batch now
6223     'custnum'  => $self->custnum,
6224     'last'     => $self->getfield('last'),
6225     'first'    => $self->getfield('first'),
6226     'address1' => $options{address1} || $self->address1,
6227     'address2' => $options{address2} || $self->address2,
6228     'city'     => $options{city}     || $self->city,
6229     'state'    => $options{state}    || $self->state,
6230     'zip'      => $options{zip}      || $self->zip,
6231     'country'  => $options{country}  || $self->country,
6232     'payby'    => $options{payby}    || $self->payby,
6233     'payinfo'  => $options{payinfo}  || $self->payinfo,
6234     'exp'      => $options{paydate}  || $self->paydate,
6235     'payname'  => $options{payname}  || $self->payname,
6236     'amount'   => $amount,                         # consolidating
6237   } );
6238
6239   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
6240     if $old_cust_pay_batch;
6241
6242   my $error;
6243   if ($old_cust_pay_batch) {
6244     $error = $cust_pay_batch->replace($old_cust_pay_batch)
6245   } else {
6246     $error = $cust_pay_batch->insert;
6247   }
6248
6249   if ( $error ) {
6250     $dbh->rollback if $oldAutoCommit;
6251     die $error;
6252   }
6253
6254   my $unapplied =   $self->total_unapplied_credits
6255                   + $self->total_unapplied_payments
6256                   + $self->in_transit_payments;
6257   foreach my $cust_bill ($self->open_cust_bill) {
6258     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
6259     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
6260       'invnum' => $cust_bill->invnum,
6261       'paybatchnum' => $cust_pay_batch->paybatchnum,
6262       'amount' => $cust_bill->owed,
6263       '_date' => time,
6264     };
6265     if ($unapplied >= $cust_bill_pay_batch->amount){
6266       $unapplied -= $cust_bill_pay_batch->amount;
6267       next;
6268     }else{
6269       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
6270                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
6271     }
6272     $error = $cust_bill_pay_batch->insert;
6273     if ( $error ) {
6274       $dbh->rollback if $oldAutoCommit;
6275       die $error;
6276     }
6277   }
6278
6279   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6280   '';
6281 }
6282
6283 =item apply_payments_and_credits [ OPTION => VALUE ... ]
6284
6285 Applies unapplied payments and credits.
6286
6287 In most cases, this new method should be used in place of sequential
6288 apply_payments and apply_credits methods.
6289
6290 A hash of optional arguments may be passed.  Currently "manual" is supported.
6291 If true, a payment receipt is sent instead of a statement when
6292 'payment_receipt_email' configuration option is set.
6293
6294 If there is an error, returns the error, otherwise returns false.
6295
6296 =cut
6297
6298 sub apply_payments_and_credits {
6299   my( $self, %options ) = @_;
6300
6301   local $SIG{HUP} = 'IGNORE';
6302   local $SIG{INT} = 'IGNORE';
6303   local $SIG{QUIT} = 'IGNORE';
6304   local $SIG{TERM} = 'IGNORE';
6305   local $SIG{TSTP} = 'IGNORE';
6306   local $SIG{PIPE} = 'IGNORE';
6307
6308   my $oldAutoCommit = $FS::UID::AutoCommit;
6309   local $FS::UID::AutoCommit = 0;
6310   my $dbh = dbh;
6311
6312   $self->select_for_update; #mutex
6313
6314   foreach my $cust_bill ( $self->open_cust_bill ) {
6315     my $error = $cust_bill->apply_payments_and_credits(%options);
6316     if ( $error ) {
6317       $dbh->rollback if $oldAutoCommit;
6318       return "Error applying: $error";
6319     }
6320   }
6321
6322   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6323   ''; #no error
6324
6325 }
6326
6327 =item apply_credits OPTION => VALUE ...
6328
6329 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
6330 to outstanding invoice balances in chronological order (or reverse
6331 chronological order if the I<order> option is set to B<newest>) and returns the
6332 value of any remaining unapplied credits available for refund (see
6333 L<FS::cust_refund>).
6334
6335 Dies if there is an error.
6336
6337 =cut
6338
6339 sub apply_credits {
6340   my $self = shift;
6341   my %opt = @_;
6342
6343   local $SIG{HUP} = 'IGNORE';
6344   local $SIG{INT} = 'IGNORE';
6345   local $SIG{QUIT} = 'IGNORE';
6346   local $SIG{TERM} = 'IGNORE';
6347   local $SIG{TSTP} = 'IGNORE';
6348   local $SIG{PIPE} = 'IGNORE';
6349
6350   my $oldAutoCommit = $FS::UID::AutoCommit;
6351   local $FS::UID::AutoCommit = 0;
6352   my $dbh = dbh;
6353
6354   $self->select_for_update; #mutex
6355
6356   unless ( $self->total_unapplied_credits ) {
6357     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6358     return 0;
6359   }
6360
6361   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
6362       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
6363
6364   my @invoices = $self->open_cust_bill;
6365   @invoices = sort { $b->_date <=> $a->_date } @invoices
6366     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
6367
6368   if ( $conf->exists('pkg-balances') ) {
6369     # limit @credits to those w/ a pkgnum grepped from $self
6370     my %pkgnums = ();
6371     foreach my $i (@invoices) {
6372       foreach my $li ( $i->cust_bill_pkg ) {
6373         $pkgnums{$li->pkgnum} = 1;
6374       }
6375     }
6376     @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
6377   }
6378
6379   my $credit;
6380
6381   foreach my $cust_bill ( @invoices ) {
6382
6383     if ( !defined($credit) || $credit->credited == 0) {
6384       $credit = pop @credits or last;
6385     }
6386
6387     my $owed;
6388     if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
6389       $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
6390     } else {
6391       $owed = $cust_bill->owed;
6392     }
6393     unless ( $owed > 0 ) {
6394       push @credits, $credit;
6395       next;
6396     }
6397
6398     my $amount = min( $credit->credited, $owed );
6399
6400     my $cust_credit_bill = new FS::cust_credit_bill ( {
6401       'crednum' => $credit->crednum,
6402       'invnum'  => $cust_bill->invnum,
6403       'amount'  => $amount,
6404     } );
6405     $cust_credit_bill->pkgnum( $credit->pkgnum )
6406       if $conf->exists('pkg-balances') && $credit->pkgnum;
6407     my $error = $cust_credit_bill->insert;
6408     if ( $error ) {
6409       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6410       die $error;
6411     }
6412
6413     redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
6414
6415   }
6416
6417   my $total_unapplied_credits = $self->total_unapplied_credits;
6418
6419   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6420
6421   return $total_unapplied_credits;
6422 }
6423
6424 =item apply_payments  [ OPTION => VALUE ... ]
6425
6426 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
6427 to outstanding invoice balances in chronological order.
6428
6429  #and returns the value of any remaining unapplied payments.
6430
6431 A hash of optional arguments may be passed.  Currently "manual" is supported.
6432 If true, a payment receipt is sent instead of a statement when
6433 'payment_receipt_email' configuration option is set.
6434
6435 Dies if there is an error.
6436
6437 =cut
6438
6439 sub apply_payments {
6440   my( $self, %options ) = @_;
6441
6442   local $SIG{HUP} = 'IGNORE';
6443   local $SIG{INT} = 'IGNORE';
6444   local $SIG{QUIT} = 'IGNORE';
6445   local $SIG{TERM} = 'IGNORE';
6446   local $SIG{TSTP} = 'IGNORE';
6447   local $SIG{PIPE} = 'IGNORE';
6448
6449   my $oldAutoCommit = $FS::UID::AutoCommit;
6450   local $FS::UID::AutoCommit = 0;
6451   my $dbh = dbh;
6452
6453   $self->select_for_update; #mutex
6454
6455   #return 0 unless
6456
6457   my @payments = sort { $b->_date <=> $a->_date }
6458                  grep { $_->unapplied > 0 }
6459                  $self->cust_pay;
6460
6461   my @invoices = sort { $a->_date <=> $b->_date}
6462                  grep { $_->owed > 0 }
6463                  $self->cust_bill;
6464
6465   if ( $conf->exists('pkg-balances') ) {
6466     # limit @payments to those w/ a pkgnum grepped from $self
6467     my %pkgnums = ();
6468     foreach my $i (@invoices) {
6469       foreach my $li ( $i->cust_bill_pkg ) {
6470         $pkgnums{$li->pkgnum} = 1;
6471       }
6472     }
6473     @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
6474   }
6475
6476   my $payment;
6477
6478   foreach my $cust_bill ( @invoices ) {
6479
6480     if ( !defined($payment) || $payment->unapplied == 0 ) {
6481       $payment = pop @payments or last;
6482     }
6483
6484     my $owed;
6485     if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
6486       $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
6487     } else {
6488       $owed = $cust_bill->owed;
6489     }
6490     unless ( $owed > 0 ) {
6491       push @payments, $payment;
6492       next;
6493     }
6494
6495     my $amount = min( $payment->unapplied, $owed );
6496
6497     my $cust_bill_pay = new FS::cust_bill_pay ( {
6498       'paynum' => $payment->paynum,
6499       'invnum' => $cust_bill->invnum,
6500       'amount' => $amount,
6501     } );
6502     $cust_bill_pay->pkgnum( $payment->pkgnum )
6503       if $conf->exists('pkg-balances') && $payment->pkgnum;
6504     my $error = $cust_bill_pay->insert(%options);
6505     if ( $error ) {
6506       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6507       die $error;
6508     }
6509
6510     redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
6511
6512   }
6513
6514   my $total_unapplied_payments = $self->total_unapplied_payments;
6515
6516   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6517
6518   return $total_unapplied_payments;
6519 }
6520
6521 =item total_owed
6522
6523 Returns the total owed for this customer on all invoices
6524 (see L<FS::cust_bill/owed>).
6525
6526 =cut
6527
6528 sub total_owed {
6529   my $self = shift;
6530   $self->total_owed_date(2145859200); #12/31/2037
6531 }
6532
6533 =item total_owed_date TIME
6534
6535 Returns the total owed for this customer on all invoices with date earlier than
6536 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
6537 see L<Time::Local> and L<Date::Parse> for conversion functions.
6538
6539 =cut
6540
6541 sub total_owed_date {
6542   my $self = shift;
6543   my $time = shift;
6544
6545 #  my $custnum = $self->custnum;
6546 #
6547 #  my $owed_sql = FS::cust_bill->owed_sql;
6548 #
6549 #  my $sql = "
6550 #    SELECT SUM($owed_sql) FROM cust_bill
6551 #      WHERE custnum = $custnum
6552 #        AND _date <= $time
6553 #  ";
6554 #
6555 #  my $sth = dbh->prepare($sql) or die dbh->errstr;
6556 #  $sth->execute() or die $sth->errstr;
6557 #
6558 #  return sprintf( '%.2f', $sth->fetchrow_arrayref->[0] );
6559
6560   my $total_bill = 0;
6561   foreach my $cust_bill (
6562     grep { $_->_date <= $time }
6563       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6564   ) {
6565     $total_bill += $cust_bill->owed;
6566   }
6567   sprintf( "%.2f", $total_bill );
6568
6569 }
6570
6571 =item total_owed_pkgnum PKGNUM
6572
6573 Returns the total owed on all invoices for this customer's specific package
6574 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
6575
6576 =cut
6577
6578 sub total_owed_pkgnum {
6579   my( $self, $pkgnum ) = @_;
6580   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
6581 }
6582
6583 =item total_owed_date_pkgnum TIME PKGNUM
6584
6585 Returns the total owed for this customer's specific package when using
6586 experimental package balances on all invoices with date earlier than
6587 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
6588 see L<Time::Local> and L<Date::Parse> for conversion functions.
6589
6590 =cut
6591
6592 sub total_owed_date_pkgnum {
6593   my( $self, $time, $pkgnum ) = @_;
6594
6595   my $total_bill = 0;
6596   foreach my $cust_bill (
6597     grep { $_->_date <= $time }
6598       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6599   ) {
6600     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
6601   }
6602   sprintf( "%.2f", $total_bill );
6603
6604 }
6605
6606 =item total_paid
6607
6608 Returns the total amount of all payments.
6609
6610 =cut
6611
6612 sub total_paid {
6613   my $self = shift;
6614   my $total = 0;
6615   $total += $_->paid foreach $self->cust_pay;
6616   sprintf( "%.2f", $total );
6617 }
6618
6619 =item total_unapplied_credits
6620
6621 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6622 customer.  See L<FS::cust_credit/credited>.
6623
6624 =item total_credited
6625
6626 Old name for total_unapplied_credits.  Don't use.
6627
6628 =cut
6629
6630 sub total_credited {
6631   #carp "total_credited deprecated, use total_unapplied_credits";
6632   shift->total_unapplied_credits(@_);
6633 }
6634
6635 sub total_unapplied_credits {
6636   my $self = shift;
6637   my $total_credit = 0;
6638   $total_credit += $_->credited foreach $self->cust_credit;
6639   sprintf( "%.2f", $total_credit );
6640 }
6641
6642 =item total_unapplied_credits_pkgnum PKGNUM
6643
6644 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6645 customer.  See L<FS::cust_credit/credited>.
6646
6647 =cut
6648
6649 sub total_unapplied_credits_pkgnum {
6650   my( $self, $pkgnum ) = @_;
6651   my $total_credit = 0;
6652   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
6653   sprintf( "%.2f", $total_credit );
6654 }
6655
6656
6657 =item total_unapplied_payments
6658
6659 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6660 See L<FS::cust_pay/unapplied>.
6661
6662 =cut
6663
6664 sub total_unapplied_payments {
6665   my $self = shift;
6666   my $total_unapplied = 0;
6667   $total_unapplied += $_->unapplied foreach $self->cust_pay;
6668   sprintf( "%.2f", $total_unapplied );
6669 }
6670
6671 =item total_unapplied_payments_pkgnum PKGNUM
6672
6673 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
6674 specific package when using experimental package balances.  See
6675 L<FS::cust_pay/unapplied>.
6676
6677 =cut
6678
6679 sub total_unapplied_payments_pkgnum {
6680   my( $self, $pkgnum ) = @_;
6681   my $total_unapplied = 0;
6682   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
6683   sprintf( "%.2f", $total_unapplied );
6684 }
6685
6686
6687 =item total_unapplied_refunds
6688
6689 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6690 customer.  See L<FS::cust_refund/unapplied>.
6691
6692 =cut
6693
6694 sub total_unapplied_refunds {
6695   my $self = shift;
6696   my $total_unapplied = 0;
6697   $total_unapplied += $_->unapplied foreach $self->cust_refund;
6698   sprintf( "%.2f", $total_unapplied );
6699 }
6700
6701 =item balance
6702
6703 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6704 total_unapplied_credits minus total_unapplied_payments).
6705
6706 =cut
6707
6708 sub balance {
6709   my $self = shift;
6710   sprintf( "%.2f",
6711       $self->total_owed
6712     + $self->total_unapplied_refunds
6713     - $self->total_unapplied_credits
6714     - $self->total_unapplied_payments
6715   );
6716 }
6717
6718 =item balance_date TIME
6719
6720 Returns the balance for this customer, only considering invoices with date
6721 earlier than TIME (total_owed_date minus total_credited minus
6722 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
6723 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
6724 functions.
6725
6726 =cut
6727
6728 sub balance_date {
6729   my $self = shift;
6730   my $time = shift;
6731   sprintf( "%.2f",
6732         $self->total_owed_date($time)
6733       + $self->total_unapplied_refunds
6734       - $self->total_unapplied_credits
6735       - $self->total_unapplied_payments
6736   );
6737 }
6738
6739 =item balance_pkgnum PKGNUM
6740
6741 Returns the balance for this customer's specific package when using
6742 experimental package balances (total_owed plus total_unrefunded, minus
6743 total_unapplied_credits minus total_unapplied_payments)
6744
6745 =cut
6746
6747 sub balance_pkgnum {
6748   my( $self, $pkgnum ) = @_;
6749
6750   sprintf( "%.2f",
6751       $self->total_owed_pkgnum($pkgnum)
6752 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
6753 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
6754     - $self->total_unapplied_credits_pkgnum($pkgnum)
6755     - $self->total_unapplied_payments_pkgnum($pkgnum)
6756   );
6757 }
6758
6759 =item in_transit_payments
6760
6761 Returns the total of requests for payments for this customer pending in
6762 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
6763
6764 =cut
6765
6766 sub in_transit_payments {
6767   my $self = shift;
6768   my $in_transit_payments = 0;
6769   foreach my $pay_batch ( qsearch('pay_batch', {
6770     'status' => 'I',
6771   } ) ) {
6772     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6773       'batchnum' => $pay_batch->batchnum,
6774       'custnum' => $self->custnum,
6775     } ) ) {
6776       $in_transit_payments += $cust_pay_batch->amount;
6777     }
6778   }
6779   sprintf( "%.2f", $in_transit_payments );
6780 }
6781
6782 =item payment_info
6783
6784 Returns a hash of useful information for making a payment.
6785
6786 =over 4
6787
6788 =item balance
6789
6790 Current balance.
6791
6792 =item payby
6793
6794 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6795 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6796 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6797
6798 =back
6799
6800 For credit card transactions:
6801
6802 =over 4
6803
6804 =item card_type 1
6805
6806 =item payname
6807
6808 Exact name on card
6809
6810 =back
6811
6812 For electronic check transactions:
6813
6814 =over 4
6815
6816 =item stateid_state
6817
6818 =back
6819
6820 =cut
6821
6822 sub payment_info {
6823   my $self = shift;
6824
6825   my %return = ();
6826
6827   $return{balance} = $self->balance;
6828
6829   $return{payname} = $self->payname
6830                      || ( $self->first. ' '. $self->get('last') );
6831
6832   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6833
6834   $return{payby} = $self->payby;
6835   $return{stateid_state} = $self->stateid_state;
6836
6837   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6838     $return{card_type} = cardtype($self->payinfo);
6839     $return{payinfo} = $self->paymask;
6840
6841     @return{'month', 'year'} = $self->paydate_monthyear;
6842
6843   }
6844
6845   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6846     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6847     $return{payinfo1} = $payinfo1;
6848     $return{payinfo2} = $payinfo2;
6849     $return{paytype}  = $self->paytype;
6850     $return{paystate} = $self->paystate;
6851
6852   }
6853
6854   #doubleclick protection
6855   my $_date = time;
6856   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6857
6858   %return;
6859
6860 }
6861
6862 =item paydate_monthyear
6863
6864 Returns a two-element list consisting of the month and year of this customer's
6865 paydate (credit card expiration date for CARD customers)
6866
6867 =cut
6868
6869 sub paydate_monthyear {
6870   my $self = shift;
6871   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6872     ( $2, $1 );
6873   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6874     ( $1, $3 );
6875   } else {
6876     ('', '');
6877   }
6878 }
6879
6880 =item tax_exemption TAXNAME
6881
6882 =cut
6883
6884 sub tax_exemption {
6885   my( $self, $taxname ) = @_;
6886
6887   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
6888                                      'taxname' => $taxname,
6889                                    },
6890           );
6891 }
6892
6893 =item cust_main_exemption
6894
6895 =cut
6896
6897 sub cust_main_exemption {
6898   my $self = shift;
6899   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
6900 }
6901
6902 =item invoicing_list [ ARRAYREF ]
6903
6904 If an arguement is given, sets these email addresses as invoice recipients
6905 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
6906 (except as warnings), so use check_invoicing_list first.
6907
6908 Returns a list of email addresses (with svcnum entries expanded).
6909
6910 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
6911 check it without disturbing anything by passing nothing.
6912
6913 This interface may change in the future.
6914
6915 =cut
6916
6917 sub invoicing_list {
6918   my( $self, $arrayref ) = @_;
6919
6920   if ( $arrayref ) {
6921     my @cust_main_invoice;
6922     if ( $self->custnum ) {
6923       @cust_main_invoice =
6924         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6925     } else {
6926       @cust_main_invoice = ();
6927     }
6928     foreach my $cust_main_invoice ( @cust_main_invoice ) {
6929       #warn $cust_main_invoice->destnum;
6930       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6931         #warn $cust_main_invoice->destnum;
6932         my $error = $cust_main_invoice->delete;
6933         warn $error if $error;
6934       }
6935     }
6936     if ( $self->custnum ) {
6937       @cust_main_invoice =
6938         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6939     } else {
6940       @cust_main_invoice = ();
6941     }
6942     my %seen = map { $_->address => 1 } @cust_main_invoice;
6943     foreach my $address ( @{$arrayref} ) {
6944       next if exists $seen{$address} && $seen{$address};
6945       $seen{$address} = 1;
6946       my $cust_main_invoice = new FS::cust_main_invoice ( {
6947         'custnum' => $self->custnum,
6948         'dest'    => $address,
6949       } );
6950       my $error = $cust_main_invoice->insert;
6951       warn $error if $error;
6952     }
6953   }
6954
6955   if ( $self->custnum ) {
6956     map { $_->address }
6957       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6958   } else {
6959     ();
6960   }
6961
6962 }
6963
6964 =item check_invoicing_list ARRAYREF
6965
6966 Checks these arguements as valid input for the invoicing_list method.  If there
6967 is an error, returns the error, otherwise returns false.
6968
6969 =cut
6970
6971 sub check_invoicing_list {
6972   my( $self, $arrayref ) = @_;
6973
6974   foreach my $address ( @$arrayref ) {
6975
6976     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6977       return 'Can\'t add FAX invoice destination with a blank FAX number.';
6978     }
6979
6980     my $cust_main_invoice = new FS::cust_main_invoice ( {
6981       'custnum' => $self->custnum,
6982       'dest'    => $address,
6983     } );
6984     my $error = $self->custnum
6985                 ? $cust_main_invoice->check
6986                 : $cust_main_invoice->checkdest
6987     ;
6988     return $error if $error;
6989
6990   }
6991
6992   return "Email address required"
6993     if $conf->exists('cust_main-require_invoicing_list_email')
6994     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6995
6996   '';
6997 }
6998
6999 =item set_default_invoicing_list
7000
7001 Sets the invoicing list to all accounts associated with this customer,
7002 overwriting any previous invoicing list.
7003
7004 =cut
7005
7006 sub set_default_invoicing_list {
7007   my $self = shift;
7008   $self->invoicing_list($self->all_emails);
7009 }
7010
7011 =item all_emails
7012
7013 Returns the email addresses of all accounts provisioned for this customer.
7014
7015 =cut
7016
7017 sub all_emails {
7018   my $self = shift;
7019   my %list;
7020   foreach my $cust_pkg ( $self->all_pkgs ) {
7021     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
7022     my @svc_acct =
7023       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
7024         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
7025           @cust_svc;
7026     $list{$_}=1 foreach map { $_->email } @svc_acct;
7027   }
7028   keys %list;
7029 }
7030
7031 =item invoicing_list_addpost
7032
7033 Adds postal invoicing to this customer.  If this customer is already configured
7034 to receive postal invoices, does nothing.
7035
7036 =cut
7037
7038 sub invoicing_list_addpost {
7039   my $self = shift;
7040   return if grep { $_ eq 'POST' } $self->invoicing_list;
7041   my @invoicing_list = $self->invoicing_list;
7042   push @invoicing_list, 'POST';
7043   $self->invoicing_list(\@invoicing_list);
7044 }
7045
7046 =item invoicing_list_emailonly
7047
7048 Returns the list of email invoice recipients (invoicing_list without non-email
7049 destinations such as POST and FAX).
7050
7051 =cut
7052
7053 sub invoicing_list_emailonly {
7054   my $self = shift;
7055   warn "$me invoicing_list_emailonly called"
7056     if $DEBUG;
7057   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
7058 }
7059
7060 =item invoicing_list_emailonly_scalar
7061
7062 Returns the list of email invoice recipients (invoicing_list without non-email
7063 destinations such as POST and FAX) as a comma-separated scalar.
7064
7065 =cut
7066
7067 sub invoicing_list_emailonly_scalar {
7068   my $self = shift;
7069   warn "$me invoicing_list_emailonly_scalar called"
7070     if $DEBUG;
7071   join(', ', $self->invoicing_list_emailonly);
7072 }
7073
7074 =item referral_custnum_cust_main
7075
7076 Returns the customer who referred this customer (or the empty string, if
7077 this customer was not referred).
7078
7079 Note the difference with referral_cust_main method: This method,
7080 referral_custnum_cust_main returns the single customer (if any) who referred
7081 this customer, while referral_cust_main returns an array of customers referred
7082 BY this customer.
7083
7084 =cut
7085
7086 sub referral_custnum_cust_main {
7087   my $self = shift;
7088   return '' unless $self->referral_custnum;
7089   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
7090 }
7091
7092 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
7093
7094 Returns an array of customers referred by this customer (referral_custnum set
7095 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
7096 customers referred by customers referred by this customer and so on, inclusive.
7097 The default behavior is DEPTH 1 (no recursion).
7098
7099 Note the difference with referral_custnum_cust_main method: This method,
7100 referral_cust_main, returns an array of customers referred BY this customer,
7101 while referral_custnum_cust_main returns the single customer (if any) who
7102 referred this customer.
7103
7104 =cut
7105
7106 sub referral_cust_main {
7107   my $self = shift;
7108   my $depth = @_ ? shift : 1;
7109   my $exclude = @_ ? shift : {};
7110
7111   my @cust_main =
7112     map { $exclude->{$_->custnum}++; $_; }
7113       grep { ! $exclude->{ $_->custnum } }
7114         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
7115
7116   if ( $depth > 1 ) {
7117     push @cust_main,
7118       map { $_->referral_cust_main($depth-1, $exclude) }
7119         @cust_main;
7120   }
7121
7122   @cust_main;
7123 }
7124
7125 =item referral_cust_main_ncancelled
7126
7127 Same as referral_cust_main, except only returns customers with uncancelled
7128 packages.
7129
7130 =cut
7131
7132 sub referral_cust_main_ncancelled {
7133   my $self = shift;
7134   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
7135 }
7136
7137 =item referral_cust_pkg [ DEPTH ]
7138
7139 Like referral_cust_main, except returns a flat list of all unsuspended (and
7140 uncancelled) packages for each customer.  The number of items in this list may
7141 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
7142
7143 =cut
7144
7145 sub referral_cust_pkg {
7146   my $self = shift;
7147   my $depth = @_ ? shift : 1;
7148
7149   map { $_->unsuspended_pkgs }
7150     grep { $_->unsuspended_pkgs }
7151       $self->referral_cust_main($depth);
7152 }
7153
7154 =item referring_cust_main
7155
7156 Returns the single cust_main record for the customer who referred this customer
7157 (referral_custnum), or false.
7158
7159 =cut
7160
7161 sub referring_cust_main {
7162   my $self = shift;
7163   return '' unless $self->referral_custnum;
7164   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
7165 }
7166
7167 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
7168
7169 Applies a credit to this customer.  If there is an error, returns the error,
7170 otherwise returns false.
7171
7172 REASON can be a text string, an FS::reason object, or a scalar reference to
7173 a reasonnum.  If a text string, it will be automatically inserted as a new
7174 reason, and a 'reason_type' option must be passed to indicate the
7175 FS::reason_type for the new reason.
7176
7177 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
7178
7179 Any other options are passed to FS::cust_credit::insert.
7180
7181 =cut
7182
7183 sub credit {
7184   my( $self, $amount, $reason, %options ) = @_;
7185
7186   my $cust_credit = new FS::cust_credit {
7187     'custnum' => $self->custnum,
7188     'amount'  => $amount,
7189   };
7190
7191   if ( ref($reason) ) {
7192
7193     if ( ref($reason) eq 'SCALAR' ) {
7194       $cust_credit->reasonnum( $$reason );
7195     } else {
7196       $cust_credit->reasonnum( $reason->reasonnum );
7197     }
7198
7199   } else {
7200     $cust_credit->set('reason', $reason)
7201   }
7202
7203   $cust_credit->addlinfo( delete $options{'addlinfo'} )
7204     if exists($options{'addlinfo'});
7205
7206   $cust_credit->insert(%options);
7207
7208 }
7209
7210 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
7211
7212 Creates a one-time charge for this customer.  If there is an error, returns
7213 the error, otherwise returns false.
7214
7215 New-style, with a hashref of options:
7216
7217   my $error = $cust_main->charge(
7218                                   {
7219                                     'amount'     => 54.32,
7220                                     'quantity'   => 1,
7221                                     'start_date' => str2time('7/4/2009'),
7222                                     'pkg'        => 'Description',
7223                                     'comment'    => 'Comment',
7224                                     'additional' => [], #extra invoice detail
7225                                     'classnum'   => 1,  #pkg_class
7226
7227                                     'setuptax'   => '', # or 'Y' for tax exempt
7228
7229                                     #internal taxation
7230                                     'taxclass'   => 'Tax class',
7231
7232                                     #vendor taxation
7233                                     'taxproduct' => 2,  #part_pkg_taxproduct
7234                                     'override'   => {}, #XXX describe
7235
7236                                     #will be filled in with the new object
7237                                     'cust_pkg_ref' => \$cust_pkg,
7238
7239                                     #generate an invoice immediately
7240                                     'bill_now' => 0,
7241                                     'invoice_terms' => '', #with these terms
7242                                   }
7243                                 );
7244
7245 Old-style:
7246
7247   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
7248
7249 =cut
7250
7251 sub charge {
7252   my $self = shift;
7253   my ( $amount, $quantity, $start_date, $classnum );
7254   my ( $pkg, $comment, $additional );
7255   my ( $setuptax, $taxclass );   #internal taxes
7256   my ( $taxproduct, $override ); #vendor (CCH) taxes
7257   my $cust_pkg_ref = '';
7258   my ( $bill_now, $invoice_terms ) = ( 0, '' );
7259   if ( ref( $_[0] ) ) {
7260     $amount     = $_[0]->{amount};
7261     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
7262     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
7263     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
7264     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
7265                                            : '$'. sprintf("%.2f",$amount);
7266     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
7267     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
7268     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
7269     $additional = $_[0]->{additional} || [];
7270     $taxproduct = $_[0]->{taxproductnum};
7271     $override   = { '' => $_[0]->{tax_override} };
7272     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
7273     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
7274     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
7275   } else {
7276     $amount     = shift;
7277     $quantity   = 1;
7278     $start_date = '';
7279     $pkg        = @_ ? shift : 'One-time charge';
7280     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
7281     $setuptax   = '';
7282     $taxclass   = @_ ? shift : '';
7283     $additional = [];
7284   }
7285
7286   local $SIG{HUP} = 'IGNORE';
7287   local $SIG{INT} = 'IGNORE';
7288   local $SIG{QUIT} = 'IGNORE';
7289   local $SIG{TERM} = 'IGNORE';
7290   local $SIG{TSTP} = 'IGNORE';
7291   local $SIG{PIPE} = 'IGNORE';
7292
7293   my $oldAutoCommit = $FS::UID::AutoCommit;
7294   local $FS::UID::AutoCommit = 0;
7295   my $dbh = dbh;
7296
7297   my $part_pkg = new FS::part_pkg ( {
7298     'pkg'           => $pkg,
7299     'comment'       => $comment,
7300     'plan'          => 'flat',
7301     'freq'          => 0,
7302     'disabled'      => 'Y',
7303     'classnum'      => $classnum ? $classnum : '',
7304     'setuptax'      => $setuptax,
7305     'taxclass'      => $taxclass,
7306     'taxproductnum' => $taxproduct,
7307   } );
7308
7309   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
7310                         ( 0 .. @$additional - 1 )
7311                   ),
7312                   'additional_count' => scalar(@$additional),
7313                   'setup_fee' => $amount,
7314                 );
7315
7316   my $error = $part_pkg->insert( options       => \%options,
7317                                  tax_overrides => $override,
7318                                );
7319   if ( $error ) {
7320     $dbh->rollback if $oldAutoCommit;
7321     return $error;
7322   }
7323
7324   my $pkgpart = $part_pkg->pkgpart;
7325   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
7326   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
7327     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
7328     $error = $type_pkgs->insert;
7329     if ( $error ) {
7330       $dbh->rollback if $oldAutoCommit;
7331       return $error;
7332     }
7333   }
7334
7335   my $cust_pkg = new FS::cust_pkg ( {
7336     'custnum'    => $self->custnum,
7337     'pkgpart'    => $pkgpart,
7338     'quantity'   => $quantity,
7339     'start_date' => $start_date,
7340   } );
7341
7342   $error = $cust_pkg->insert;
7343   if ( $error ) {
7344     $dbh->rollback if $oldAutoCommit;
7345     return $error;
7346   } elsif ( $cust_pkg_ref ) {
7347     ${$cust_pkg_ref} = $cust_pkg;
7348   }
7349
7350   if ( $bill_now ) {
7351     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
7352                              'pkg_list'      => [ $cust_pkg ],
7353                            );
7354     if ( $error ) {
7355       $dbh->rollback if $oldAutoCommit;
7356       return $error;
7357     }
7358   }
7359
7360   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
7361   return '';
7362
7363 }
7364
7365 #=item charge_postal_fee
7366 #
7367 #Applies a one time charge this customer.  If there is an error,
7368 #returns the error, returns the cust_pkg charge object or false
7369 #if there was no charge.
7370 #
7371 #=cut
7372 #
7373 # This should be a customer event.  For that to work requires that bill
7374 # also be a customer event.
7375
7376 sub charge_postal_fee {
7377   my $self = shift;
7378
7379   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
7380   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
7381
7382   my $cust_pkg = new FS::cust_pkg ( {
7383     'custnum'  => $self->custnum,
7384     'pkgpart'  => $pkgpart,
7385     'quantity' => 1,
7386   } );
7387
7388   my $error = $cust_pkg->insert;
7389   $error ? $error : $cust_pkg;
7390 }
7391
7392 =item cust_bill
7393
7394 Returns all the invoices (see L<FS::cust_bill>) for this customer.
7395
7396 =cut
7397
7398 sub cust_bill {
7399   my $self = shift;
7400   map { $_ } #return $self->num_cust_bill unless wantarray;
7401   sort { $a->_date <=> $b->_date }
7402     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
7403 }
7404
7405 =item open_cust_bill
7406
7407 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
7408 customer.
7409
7410 =cut
7411
7412 sub open_cust_bill {
7413   my $self = shift;
7414
7415   qsearch({
7416     'table'     => 'cust_bill',
7417     'hashref'   => { 'custnum' => $self->custnum, },
7418     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
7419     'order_by'  => 'ORDER BY _date ASC',
7420   });
7421
7422 }
7423
7424 =item cust_statements
7425
7426 Returns all the statements (see L<FS::cust_statement>) for this customer.
7427
7428 =cut
7429
7430 sub cust_statement {
7431   my $self = shift;
7432   map { $_ } #return $self->num_cust_statement unless wantarray;
7433   sort { $a->_date <=> $b->_date }
7434     qsearch('cust_statement', { 'custnum' => $self->custnum, } )
7435 }
7436
7437 =item cust_credit
7438
7439 Returns all the credits (see L<FS::cust_credit>) for this customer.
7440
7441 =cut
7442
7443 sub cust_credit {
7444   my $self = shift;
7445   map { $_ } #return $self->num_cust_credit unless wantarray;
7446   sort { $a->_date <=> $b->_date }
7447     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
7448 }
7449
7450 =item cust_credit_pkgnum
7451
7452 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
7453 package when using experimental package balances.
7454
7455 =cut
7456
7457 sub cust_credit_pkgnum {
7458   my( $self, $pkgnum ) = @_;
7459   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
7460   sort { $a->_date <=> $b->_date }
7461     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
7462                               'pkgnum'  => $pkgnum,
7463                             }
7464     );
7465 }
7466
7467 =item cust_pay
7468
7469 Returns all the payments (see L<FS::cust_pay>) for this customer.
7470
7471 =cut
7472
7473 sub cust_pay {
7474   my $self = shift;
7475   return $self->num_cust_pay unless wantarray;
7476   sort { $a->_date <=> $b->_date }
7477     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
7478 }
7479
7480 =item num_cust_pay
7481
7482 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
7483 called automatically when the cust_pay method is used in a scalar context.
7484
7485 =cut
7486
7487 sub num_cust_pay {
7488   my $self = shift;
7489   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
7490   my $sth = dbh->prepare($sql) or die dbh->errstr;
7491   $sth->execute($self->custnum) or die $sth->errstr;
7492   $sth->fetchrow_arrayref->[0];
7493 }
7494
7495 =item cust_pay_pkgnum
7496
7497 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
7498 package when using experimental package balances.
7499
7500 =cut
7501
7502 sub cust_pay_pkgnum {
7503   my( $self, $pkgnum ) = @_;
7504   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
7505   sort { $a->_date <=> $b->_date }
7506     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
7507                            'pkgnum'  => $pkgnum,
7508                          }
7509     );
7510 }
7511
7512 =item cust_pay_void
7513
7514 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
7515
7516 =cut
7517
7518 sub cust_pay_void {
7519   my $self = shift;
7520   map { $_ } #return $self->num_cust_pay_void unless wantarray;
7521   sort { $a->_date <=> $b->_date }
7522     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
7523 }
7524
7525 =item cust_pay_batch
7526
7527 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
7528
7529 =cut
7530
7531 sub cust_pay_batch {
7532   my $self = shift;
7533   map { $_ } #return $self->num_cust_pay_batch unless wantarray;
7534   sort { $a->paybatchnum <=> $b->paybatchnum }
7535     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
7536 }
7537
7538 =item cust_pay_pending
7539
7540 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
7541 (without status "done").
7542
7543 =cut
7544
7545 sub cust_pay_pending {
7546   my $self = shift;
7547   return $self->num_cust_pay_pending unless wantarray;
7548   sort { $a->_date <=> $b->_date }
7549     qsearch( 'cust_pay_pending', {
7550                                    'custnum' => $self->custnum,
7551                                    'status'  => { op=>'!=', value=>'done' },
7552                                  },
7553            );
7554 }
7555
7556 =item num_cust_pay_pending
7557
7558 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
7559 customer (without status "done").  Also called automatically when the
7560 cust_pay_pending method is used in a scalar context.
7561
7562 =cut
7563
7564 sub num_cust_pay_pending {
7565   my $self = shift;
7566   my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
7567             "   WHERE custnum = ? AND status != 'done' ";
7568   my $sth = dbh->prepare($sql) or die dbh->errstr;
7569   $sth->execute($self->custnum) or die $sth->errstr;
7570   $sth->fetchrow_arrayref->[0];
7571 }
7572
7573 =item cust_refund
7574
7575 Returns all the refunds (see L<FS::cust_refund>) for this customer.
7576
7577 =cut
7578
7579 sub cust_refund {
7580   my $self = shift;
7581   map { $_ } #return $self->num_cust_refund unless wantarray;
7582   sort { $a->_date <=> $b->_date }
7583     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
7584 }
7585
7586 =item display_custnum
7587
7588 Returns the displayed customer number for this customer: agent_custid if
7589 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
7590
7591 =cut
7592
7593 sub display_custnum {
7594   my $self = shift;
7595   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
7596     return $self->agent_custid;
7597   } else {
7598     return $self->custnum;
7599   }
7600 }
7601
7602 =item name
7603
7604 Returns a name string for this customer, either "Company (Last, First)" or
7605 "Last, First".
7606
7607 =cut
7608
7609 sub name {
7610   my $self = shift;
7611   my $name = $self->contact;
7612   $name = $self->company. " ($name)" if $self->company;
7613   $name;
7614 }
7615
7616 =item ship_name
7617
7618 Returns a name string for this (service/shipping) contact, either
7619 "Company (Last, First)" or "Last, First".
7620
7621 =cut
7622
7623 sub ship_name {
7624   my $self = shift;
7625   if ( $self->get('ship_last') ) {
7626     my $name = $self->ship_contact;
7627     $name = $self->ship_company. " ($name)" if $self->ship_company;
7628     $name;
7629   } else {
7630     $self->name;
7631   }
7632 }
7633
7634 =item name_short
7635
7636 Returns a name string for this customer, either "Company" or "First Last".
7637
7638 =cut
7639
7640 sub name_short {
7641   my $self = shift;
7642   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
7643 }
7644
7645 =item ship_name_short
7646
7647 Returns a name string for this (service/shipping) contact, either "Company"
7648 or "First Last".
7649
7650 =cut
7651
7652 sub ship_name_short {
7653   my $self = shift;
7654   if ( $self->get('ship_last') ) {
7655     $self->ship_company !~ /^\s*$/
7656       ? $self->ship_company
7657       : $self->ship_contact_firstlast;
7658   } else {
7659     $self->name_company_or_firstlast;
7660   }
7661 }
7662
7663 =item contact
7664
7665 Returns this customer's full (billing) contact name only, "Last, First"
7666
7667 =cut
7668
7669 sub contact {
7670   my $self = shift;
7671   $self->get('last'). ', '. $self->first;
7672 }
7673
7674 =item ship_contact
7675
7676 Returns this customer's full (shipping) contact name only, "Last, First"
7677
7678 =cut
7679
7680 sub ship_contact {
7681   my $self = shift;
7682   $self->get('ship_last')
7683     ? $self->get('ship_last'). ', '. $self->ship_first
7684     : $self->contact;
7685 }
7686
7687 =item contact_firstlast
7688
7689 Returns this customers full (billing) contact name only, "First Last".
7690
7691 =cut
7692
7693 sub contact_firstlast {
7694   my $self = shift;
7695   $self->first. ' '. $self->get('last');
7696 }
7697
7698 =item ship_contact_firstlast
7699
7700 Returns this customer's full (shipping) contact name only, "First Last".
7701
7702 =cut
7703
7704 sub ship_contact_firstlast {
7705   my $self = shift;
7706   $self->get('ship_last')
7707     ? $self->first. ' '. $self->get('ship_last')
7708     : $self->contact_firstlast;
7709 }
7710
7711 =item country_full
7712
7713 Returns this customer's full country name
7714
7715 =cut
7716
7717 sub country_full {
7718   my $self = shift;
7719   code2country($self->country);
7720 }
7721
7722 =item geocode DATA_VENDOR
7723
7724 Returns a value for the customer location as encoded by DATA_VENDOR.
7725 Currently this only makes sense for "CCH" as DATA_VENDOR.
7726
7727 =cut
7728
7729 sub geocode {
7730   my ($self, $data_vendor) = (shift, shift);  #always cch for now
7731
7732   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
7733   return $geocode if $geocode;
7734
7735   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7736                ? 'ship_'
7737                : '';
7738
7739   my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7740     if $self->country eq 'US';
7741
7742   #CCH specific location stuff
7743   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7744
7745   my @cust_tax_location =
7746     qsearch( {
7747                'table'     => 'cust_tax_location',
7748                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7749                'extra_sql' => $extra_sql,
7750                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
7751              }
7752            );
7753   $geocode = $cust_tax_location[0]->geocode
7754     if scalar(@cust_tax_location);
7755
7756   $geocode;
7757 }
7758
7759 =item cust_status
7760
7761 =item status
7762
7763 Returns a status string for this customer, currently:
7764
7765 =over 4
7766
7767 =item prospect - No packages have ever been ordered
7768
7769 =item active - One or more recurring packages is active
7770
7771 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7772
7773 =item suspended - All non-cancelled recurring packages are suspended
7774
7775 =item cancelled - All recurring packages are cancelled
7776
7777 =back
7778
7779 =cut
7780
7781 sub status { shift->cust_status(@_); }
7782
7783 sub cust_status {
7784   my $self = shift;
7785   for my $status (qw( prospect active inactive suspended cancelled )) {
7786     my $method = $status.'_sql';
7787     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7788     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7789     $sth->execute( ($self->custnum) x $numnum )
7790       or die "Error executing 'SELECT $sql': ". $sth->errstr;
7791     return $status if $sth->fetchrow_arrayref->[0];
7792   }
7793 }
7794
7795 =item ucfirst_cust_status
7796
7797 =item ucfirst_status
7798
7799 Returns the status with the first character capitalized.
7800
7801 =cut
7802
7803 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7804
7805 sub ucfirst_cust_status {
7806   my $self = shift;
7807   ucfirst($self->cust_status);
7808 }
7809
7810 =item statuscolor
7811
7812 Returns a hex triplet color string for this customer's status.
7813
7814 =cut
7815
7816 use vars qw(%statuscolor);
7817 tie %statuscolor, 'Tie::IxHash',
7818   'prospect'  => '7e0079', #'000000', #black?  naw, purple
7819   'active'    => '00CC00', #green
7820   'inactive'  => '0000CC', #blue
7821   'suspended' => 'FF9900', #yellow
7822   'cancelled' => 'FF0000', #red
7823 ;
7824
7825 sub statuscolor { shift->cust_statuscolor(@_); }
7826
7827 sub cust_statuscolor {
7828   my $self = shift;
7829   $statuscolor{$self->cust_status};
7830 }
7831
7832 =item tickets
7833
7834 Returns an array of hashes representing the customer's RT tickets.
7835
7836 =cut
7837
7838 sub tickets {
7839   my $self = shift;
7840
7841   my $num = $conf->config('cust_main-max_tickets') || 10;
7842   my @tickets = ();
7843
7844   if ( $conf->config('ticket_system') ) {
7845     unless ( $conf->config('ticket_system-custom_priority_field') ) {
7846
7847       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7848
7849     } else {
7850
7851       foreach my $priority (
7852         $conf->config('ticket_system-custom_priority_field-values'), ''
7853       ) {
7854         last if scalar(@tickets) >= $num;
7855         push @tickets,
7856           @{ FS::TicketSystem->customer_tickets( $self->custnum,
7857                                                  $num - scalar(@tickets),
7858                                                  $priority,
7859                                                )
7860            };
7861       }
7862     }
7863   }
7864   (@tickets);
7865 }
7866
7867 # Return services representing svc_accts in customer support packages
7868 sub support_services {
7869   my $self = shift;
7870   my %packages = map { $_ => 1 } $conf->config('support_packages');
7871
7872   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7873     grep { $_->part_svc->svcdb eq 'svc_acct' }
7874     map { $_->cust_svc }
7875     grep { exists $packages{ $_->pkgpart } }
7876     $self->ncancelled_pkgs;
7877
7878 }
7879
7880 # Return a list of latitude/longitude for one of the services (if any)
7881 sub service_coordinates {
7882   my $self = shift;
7883
7884   my @svc_X =
7885     grep { $_->latitude && $_->longitude }
7886     map { $_->svc_x }
7887     map { $_->cust_svc }
7888     $self->ncancelled_pkgs;
7889
7890   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
7891 }
7892
7893 =back
7894
7895 =head1 CLASS METHODS
7896
7897 =over 4
7898
7899 =item statuses
7900
7901 Class method that returns the list of possible status strings for customers
7902 (see L<the status method|/status>).  For example:
7903
7904   @statuses = FS::cust_main->statuses();
7905
7906 =cut
7907
7908 sub statuses {
7909   #my $self = shift; #could be class...
7910   keys %statuscolor;
7911 }
7912
7913 =item prospect_sql
7914
7915 Returns an SQL expression identifying prospective cust_main records (customers
7916 with no packages ever ordered)
7917
7918 =cut
7919
7920 use vars qw($select_count_pkgs);
7921 $select_count_pkgs =
7922   "SELECT COUNT(*) FROM cust_pkg
7923     WHERE cust_pkg.custnum = cust_main.custnum";
7924
7925 sub select_count_pkgs_sql {
7926   $select_count_pkgs;
7927 }
7928
7929 sub prospect_sql { "
7930   0 = ( $select_count_pkgs )
7931 "; }
7932
7933 =item active_sql
7934
7935 Returns an SQL expression identifying active cust_main records (customers with
7936 active recurring packages).
7937
7938 =cut
7939
7940 sub active_sql { "
7941   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
7942       )
7943 "; }
7944
7945 =item inactive_sql
7946
7947 Returns an SQL expression identifying inactive cust_main records (customers with
7948 no active recurring packages, but otherwise unsuspended/uncancelled).
7949
7950 =cut
7951
7952 sub inactive_sql { "
7953   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7954   AND
7955   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7956 "; }
7957
7958 =item susp_sql
7959 =item suspended_sql
7960
7961 Returns an SQL expression identifying suspended cust_main records.
7962
7963 =cut
7964
7965
7966 sub suspended_sql { susp_sql(@_); }
7967 sub susp_sql { "
7968     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
7969     AND
7970     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
7971 "; }
7972
7973 =item cancel_sql
7974 =item cancelled_sql
7975
7976 Returns an SQL expression identifying cancelled cust_main records.
7977
7978 =cut
7979
7980 sub cancelled_sql { cancel_sql(@_); }
7981 sub cancel_sql {
7982
7983   my $recurring_sql = FS::cust_pkg->recurring_sql;
7984   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7985
7986   "
7987         0 < ( $select_count_pkgs )
7988     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
7989     AND 0 = ( $select_count_pkgs AND $recurring_sql
7990                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7991             )
7992     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7993   ";
7994
7995 }
7996
7997 =item uncancel_sql
7998 =item uncancelled_sql
7999
8000 Returns an SQL expression identifying un-cancelled cust_main records.
8001
8002 =cut
8003
8004 sub uncancelled_sql { uncancel_sql(@_); }
8005 sub uncancel_sql { "
8006   ( 0 < ( $select_count_pkgs
8007                    AND ( cust_pkg.cancel IS NULL
8008                          OR cust_pkg.cancel = 0
8009                        )
8010         )
8011     OR 0 = ( $select_count_pkgs )
8012   )
8013 "; }
8014
8015 =item balance_sql
8016
8017 Returns an SQL fragment to retreive the balance.
8018
8019 =cut
8020
8021 sub balance_sql { "
8022     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
8023         WHERE cust_bill.custnum   = cust_main.custnum     )
8024   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
8025         WHERE cust_pay.custnum    = cust_main.custnum     )
8026   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
8027         WHERE cust_credit.custnum = cust_main.custnum     )
8028   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
8029         WHERE cust_refund.custnum = cust_main.custnum     )
8030 "; }
8031
8032 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
8033
8034 Returns an SQL fragment to retreive the balance for this customer, only
8035 considering invoices with date earlier than START_TIME, and optionally not
8036 later than END_TIME (total_owed_date minus total_unapplied_credits minus
8037 total_unapplied_payments).
8038
8039 Times are specified as SQL fragments or numeric
8040 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
8041 L<Date::Parse> for conversion functions.  The empty string can be passed
8042 to disable that time constraint completely.
8043
8044 Available options are:
8045
8046 =over 4
8047
8048 =item unapplied_date
8049
8050 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)
8051
8052 =item total
8053
8054 (unused.  obsolete?)
8055 set to true to remove all customer comparison clauses, for totals
8056
8057 =item where
8058
8059 (unused.  obsolete?)
8060 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
8061
8062 =item join
8063
8064 (unused.  obsolete?)
8065 JOIN clause (typically used with the total option)
8066
8067 =back
8068
8069 =cut
8070
8071 sub balance_date_sql {
8072   my( $class, $start, $end, %opt ) = @_;
8073
8074   my $owed         = FS::cust_bill->owed_sql;
8075   my $unapp_refund = FS::cust_refund->unapplied_sql;
8076   my $unapp_credit = FS::cust_credit->unapplied_sql;
8077   my $unapp_pay    = FS::cust_pay->unapplied_sql;
8078
8079   my $j = $opt{'join'} || '';
8080
8081   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
8082   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
8083   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
8084   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
8085
8086   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
8087     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
8088     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
8089     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
8090   ";
8091
8092 }
8093
8094 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
8095
8096 Returns an SQL fragment to retreive the total unapplied payments for this
8097 customer, only considering invoices with date earlier than START_TIME, and
8098 optionally not later than END_TIME.
8099
8100 Times are specified as SQL fragments or numeric
8101 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
8102 L<Date::Parse> for conversion functions.  The empty string can be passed
8103 to disable that time constraint completely.
8104
8105 Available options are:
8106
8107 =cut
8108
8109 sub unapplied_payments_date_sql {
8110   my( $class, $start, $end, ) = @_;
8111
8112   my $unapp_pay    = FS::cust_pay->unapplied_sql;
8113
8114   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
8115                                                           'unapplied_date'=>1 );
8116
8117   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
8118 }
8119
8120 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
8121
8122 Helper method for balance_date_sql; name (and usage) subject to change
8123 (suggestions welcome).
8124
8125 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
8126 cust_refund, cust_credit or cust_pay).
8127
8128 If TABLE is "cust_bill" or the unapplied_date option is true, only
8129 considers records with date earlier than START_TIME, and optionally not
8130 later than END_TIME .
8131
8132 =cut
8133
8134 sub _money_table_where {
8135   my( $class, $table, $start, $end, %opt ) = @_;
8136
8137   my @where = ();
8138   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
8139   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
8140     push @where, "$table._date <= $start" if defined($start) && length($start);
8141     push @where, "$table._date >  $end"   if defined($end)   && length($end);
8142   }
8143   push @where, @{$opt{'where'}} if $opt{'where'};
8144   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
8145
8146   $where;
8147
8148 }
8149
8150 =item search_sql HASHREF
8151
8152 (Class method)
8153
8154 Returns a qsearch hash expression to search for parameters specified in HREF.
8155 Valid parameters are
8156
8157 =over 4
8158
8159 =item agentnum
8160
8161 =item status
8162
8163 =item cancelled_pkgs
8164
8165 bool
8166
8167 =item signupdate
8168
8169 listref of start date, end date
8170
8171 =item payby
8172
8173 listref
8174
8175 =item paydate_year
8176
8177 =item paydate_month
8178
8179 =item current_balance
8180
8181 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
8182
8183 =item cust_fields
8184
8185 =item flattened_pkgs
8186
8187 bool
8188
8189 =back
8190
8191 =cut
8192
8193 sub search_sql {
8194   my ($class, $params) = @_;
8195
8196   my $dbh = dbh;
8197
8198   my @where = ();
8199   my $orderby;
8200
8201   ##
8202   # parse agent
8203   ##
8204
8205   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
8206     push @where,
8207       "cust_main.agentnum = $1";
8208   }
8209
8210   ##
8211   # parse status
8212   ##
8213
8214   #prospect active inactive suspended cancelled
8215   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
8216     my $method = $params->{'status'}. '_sql';
8217     #push @where, $class->$method();
8218     push @where, FS::cust_main->$method();
8219   }
8220
8221   ##
8222   # parse cancelled package checkbox
8223   ##
8224
8225   my $pkgwhere = "";
8226
8227   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
8228     unless $params->{'cancelled_pkgs'};
8229
8230   ##
8231   # parse without census tract checkbox
8232   ##
8233
8234   push @where, "(censustract = '' or censustract is null)"
8235     if $params->{'no_censustract'};
8236
8237   ##
8238   # dates
8239   ##
8240
8241   foreach my $field (qw( signupdate )) {
8242
8243     next unless exists($params->{$field});
8244
8245     my($beginning, $ending) = @{$params->{$field}};
8246
8247     push @where,
8248       "cust_main.$field IS NOT NULL",
8249       "cust_main.$field >= $beginning",
8250       "cust_main.$field <= $ending";
8251
8252     $orderby ||= "ORDER BY cust_main.$field";
8253
8254   }
8255
8256   ###
8257   # payby
8258   ###
8259
8260   my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
8261   if ( @payby ) {
8262     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
8263   }
8264
8265   ###
8266   # paydate_year / paydate_month
8267   ###
8268
8269   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
8270     my $year = $1;
8271     $params->{'paydate_month'} =~ /^(\d\d?)$/
8272       or die "paydate_year without paydate_month?";
8273     my $month = $1;
8274
8275     push @where,
8276       'paydate IS NOT NULL',
8277       "paydate != ''",
8278       "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
8279 ;
8280   }
8281
8282   ###
8283   # invoice terms
8284   ###
8285
8286   if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
8287     my $terms = $1;
8288     if ( $1 eq 'NULL' ) {
8289       push @where,
8290         "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
8291     } else {
8292       push @where,
8293         "cust_main.invoice_terms IS NOT NULL",
8294         "cust_main.invoice_terms = '$1'";
8295     }
8296   }
8297
8298   ##
8299   # amounts
8300   ##
8301
8302   #my $balance_sql = $class->balance_sql();
8303   my $balance_sql = FS::cust_main->balance_sql();
8304
8305   push @where, map { s/current_balance/$balance_sql/; $_ }
8306                    @{ $params->{'current_balance'} };
8307
8308   ##
8309   # custbatch
8310   ##
8311
8312   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
8313     push @where,
8314       "cust_main.custbatch = '$1'";
8315   }
8316
8317   ##
8318   # setup queries, subs, etc. for the search
8319   ##
8320
8321   $orderby ||= 'ORDER BY custnum';
8322
8323   # here is the agent virtualization
8324   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
8325
8326   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
8327
8328   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
8329
8330   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
8331
8332   my $select = join(', ',
8333                  'cust_main.custnum',
8334                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
8335                );
8336
8337   my(@extra_headers) = ();
8338   my(@extra_fields)  = ();
8339
8340   if ($params->{'flattened_pkgs'}) {
8341
8342     if ($dbh->{Driver}->{Name} eq 'Pg') {
8343
8344       $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";
8345
8346     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
8347       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
8348       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
8349     }else{
8350       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
8351            "omitting packing information from report.";
8352     }
8353
8354     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";
8355
8356     my $sth = dbh->prepare($header_query) or die dbh->errstr;
8357     $sth->execute() or die $sth->errstr;
8358     my $headerrow = $sth->fetchrow_arrayref;
8359     my $headercount = $headerrow ? $headerrow->[0] : 0;
8360     while($headercount) {
8361       unshift @extra_headers, "Package ". $headercount;
8362       unshift @extra_fields, eval q!sub {my $c = shift;
8363                                          my @a = split '\|', $c->magic;
8364                                          my $p = $a[!.--$headercount. q!];
8365                                          $p;
8366                                         };!;
8367     }
8368
8369   }
8370
8371   my $sql_query = {
8372     'table'         => 'cust_main',
8373     'select'        => $select,
8374     'hashref'       => {},
8375     'extra_sql'     => $extra_sql,
8376     'order_by'      => $orderby,
8377     'count_query'   => $count_query,
8378     'extra_headers' => \@extra_headers,
8379     'extra_fields'  => \@extra_fields,
8380   };
8381
8382 }
8383
8384 =item email_search_sql HASHREF
8385
8386 (Class method)
8387
8388 Emails a notice to the specified customers.
8389
8390 Valid parameters are those of the L<search_sql> method, plus the following:
8391
8392 =over 4
8393
8394 =item from
8395
8396 From: address
8397
8398 =item subject
8399
8400 Email Subject:
8401
8402 =item html_body
8403
8404 HTML body
8405
8406 =item text_body
8407
8408 Text body
8409
8410 =item job
8411
8412 Optional job queue job for status updates.
8413
8414 =back
8415
8416 Returns an error message, or false for success.
8417
8418 If an error occurs during any email, stops the enture send and returns that
8419 error.  Presumably if you're getting SMTP errors aborting is better than
8420 retrying everything.
8421
8422 =cut
8423
8424 sub email_search_sql {
8425   my($class, $params) = @_;
8426
8427   my $from = delete $params->{from};
8428   my $subject = delete $params->{subject};
8429   my $html_body = delete $params->{html_body};
8430   my $text_body = delete $params->{text_body};
8431
8432   my $job = delete $params->{'job'};
8433
8434   $params->{'payby'} = [ split(/\0/, $params->{'payby'}) ]
8435     unless ref($params->{'payby'});
8436
8437   my $sql_query = $class->search_sql($params);
8438
8439   my $count_query   = delete($sql_query->{'count_query'});
8440   my $count_sth = dbh->prepare($count_query)
8441     or die "Error preparing $count_query: ". dbh->errstr;
8442   $count_sth->execute
8443     or die "Error executing $count_query: ". $count_sth->errstr;
8444   my $count_arrayref = $count_sth->fetchrow_arrayref;
8445   my $num_cust = $count_arrayref->[0];
8446
8447   #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
8448   #my @extra_fields  = @{ delete($sql_query->{'extra_fields'})  };
8449
8450
8451   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
8452
8453   #eventually order+limit magic to reduce memory use?
8454   foreach my $cust_main ( qsearch($sql_query) ) {
8455
8456     my $to = $cust_main->invoicing_list_emailonly_scalar;
8457     next unless $to;
8458
8459     my $error = send_email(
8460       generate_email(
8461         'from'      => $from,
8462         'to'        => $to,
8463         'subject'   => $subject,
8464         'html_body' => $html_body,
8465         'text_body' => $text_body,
8466       )
8467     );
8468     return $error if $error;
8469
8470     if ( $job ) { #progressbar foo
8471       $num++;
8472       if ( time - $min_sec > $last ) {
8473         my $error = $job->update_statustext(
8474           int( 100 * $num / $num_cust )
8475         );
8476         die $error if $error;
8477         $last = time;
8478       }
8479     }
8480
8481   }
8482
8483   return '';
8484 }
8485
8486 use Storable qw(thaw);
8487 use Data::Dumper;
8488 use MIME::Base64;
8489 sub process_email_search_sql {
8490   my $job = shift;
8491   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
8492
8493   my $param = thaw(decode_base64(shift));
8494   warn Dumper($param) if $DEBUG;
8495
8496   $param->{'job'} = $job;
8497
8498   $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
8499     unless ref($param->{'payby'});
8500
8501   my $error = FS::cust_main->email_search_sql( $param );
8502   die $error if $error;
8503
8504 }
8505
8506 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
8507
8508 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
8509 records.  Currently, I<first>, I<last>, I<company> and/or I<address1> may be
8510 specified (the appropriate ship_ field is also searched).
8511
8512 Additional options are the same as FS::Record::qsearch
8513
8514 =cut
8515
8516 sub fuzzy_search {
8517   my( $self, $fuzzy, $hash, @opt) = @_;
8518   #$self
8519   $hash ||= {};
8520   my @cust_main = ();
8521
8522   check_and_rebuild_fuzzyfiles();
8523   foreach my $field ( keys %$fuzzy ) {
8524
8525     my $all = $self->all_X($field);
8526     next unless scalar(@$all);
8527
8528     my %match = ();
8529     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
8530
8531     my @fcust = ();
8532     foreach ( keys %match ) {
8533       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
8534       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
8535     }
8536     my %fsaw = ();
8537     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
8538   }
8539
8540   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
8541   my %saw = ();
8542   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
8543
8544   @cust_main;
8545
8546 }
8547
8548 =item masked FIELD
8549
8550 Returns a masked version of the named field
8551
8552 =cut
8553
8554 sub masked {
8555 my ($self,$field) = @_;
8556
8557 # Show last four
8558
8559 'x'x(length($self->getfield($field))-4).
8560   substr($self->getfield($field), (length($self->getfield($field))-4));
8561
8562 }
8563
8564 =back
8565
8566 =head1 SUBROUTINES
8567
8568 =over 4
8569
8570 =item smart_search OPTION => VALUE ...
8571
8572 Accepts the following options: I<search>, the string to search for.  The string
8573 will be searched for as a customer number, phone number, name or company name,
8574 as an exact, or, in some cases, a substring or fuzzy match (see the source code
8575 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
8576 skip fuzzy matching when an exact match is found.
8577
8578 Any additional options are treated as an additional qualifier on the search
8579 (i.e. I<agentnum>).
8580
8581 Returns a (possibly empty) array of FS::cust_main objects.
8582
8583 =cut
8584
8585 sub smart_search {
8586   my %options = @_;
8587
8588   #here is the agent virtualization
8589   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8590
8591   my @cust_main = ();
8592
8593   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
8594   my $search = delete $options{'search'};
8595   ( my $alphanum_search = $search ) =~ s/\W//g;
8596
8597   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
8598
8599     #false laziness w/Record::ut_phone
8600     my $phonen = "$1-$2-$3";
8601     $phonen .= " x$4" if $4;
8602
8603     push @cust_main, qsearch( {
8604       'table'   => 'cust_main',
8605       'hashref' => { %options },
8606       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8607                      ' ( '.
8608                          join(' OR ', map "$_ = '$phonen'",
8609                                           qw( daytime night fax
8610                                               ship_daytime ship_night ship_fax )
8611                              ).
8612                      ' ) '.
8613                      " AND $agentnums_sql", #agent virtualization
8614     } );
8615
8616     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
8617       #try looking for matches with extensions unless one was specified
8618
8619       push @cust_main, qsearch( {
8620         'table'   => 'cust_main',
8621         'hashref' => { %options },
8622         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8623                        ' ( '.
8624                            join(' OR ', map "$_ LIKE '$phonen\%'",
8625                                             qw( daytime night
8626                                                 ship_daytime ship_night )
8627                                ).
8628                        ' ) '.
8629                        " AND $agentnums_sql", #agent virtualization
8630       } );
8631
8632     }
8633
8634   # custnum search (also try agent_custid), with some tweaking options if your
8635   # legacy cust "numbers" have letters
8636   }
8637
8638   if ( $search =~ /^\s*(\d+)\s*$/
8639          || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
8640               && $search =~ /^\s*(\w\w?\d+)\s*$/
8641             )
8642          || ( $conf->exists('address1-search' )
8643               && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
8644             )
8645      )
8646   {
8647
8648     my $num = $1;
8649
8650     if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
8651       push @cust_main, qsearch( {
8652         'table'     => 'cust_main',
8653         'hashref'   => { 'custnum' => $num, %options },
8654         'extra_sql' => " AND $agentnums_sql", #agent virtualization
8655       } );
8656     }
8657
8658     push @cust_main, qsearch( {
8659       'table'     => 'cust_main',
8660       'hashref'   => { 'agent_custid' => $num, %options },
8661       'extra_sql' => " AND $agentnums_sql", #agent virtualization
8662     } );
8663
8664     if ( $conf->exists('address1-search') ) {
8665       my $len = length($num);
8666       $num = lc($num);
8667       foreach my $prefix ( '', 'ship_' ) {
8668         push @cust_main, qsearch( {
8669           'table'     => 'cust_main',
8670           'hashref'   => { %options, },
8671           'extra_sql' =>
8672             ( keys(%options) ? ' AND ' : ' WHERE ' ).
8673             " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ".
8674             " AND $agentnums_sql",
8675         } );
8676       }
8677     }
8678
8679   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
8680
8681     my($company, $last, $first) = ( $1, $2, $3 );
8682
8683     # "Company (Last, First)"
8684     #this is probably something a browser remembered,
8685     #so just do an exact (but case-insensitive) search
8686
8687     foreach my $prefix ( '', 'ship_' ) {
8688       push @cust_main, qsearch( {
8689         'table'     => 'cust_main',
8690         'hashref'   => { $prefix.'first'   => $first,
8691                          $prefix.'last'    => $last,
8692                          $prefix.'company' => $company,
8693                          %options,
8694                        },
8695         'extra_sql' => " AND $agentnums_sql",
8696       } );
8697     }
8698
8699   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
8700                                               # try (ship_){last,company}
8701
8702     my $value = lc($1);
8703
8704     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
8705     # # full strings the browser remembers won't work
8706     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
8707
8708     use Lingua::EN::NameParse;
8709     my $NameParse = new Lingua::EN::NameParse(
8710              auto_clean     => 1,
8711              allow_reversed => 1,
8712     );
8713
8714     my($last, $first) = ( '', '' );
8715     #maybe disable this too and just rely on NameParse?
8716     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
8717
8718       ($last, $first) = ( $1, $2 );
8719
8720     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
8721     } elsif ( ! $NameParse->parse($value) ) {
8722
8723       my %name = $NameParse->components;
8724       $first = $name{'given_name_1'};
8725       $last  = $name{'surname_1'};
8726
8727     }
8728
8729     if ( $first && $last ) {
8730
8731       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
8732
8733       #exact
8734       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8735       $sql .= "
8736         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
8737            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
8738         )";
8739
8740       push @cust_main, qsearch( {
8741         'table'     => 'cust_main',
8742         'hashref'   => \%options,
8743         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8744       } );
8745
8746       # or it just be something that was typed in... (try that in a sec)
8747
8748     }
8749
8750     my $q_value = dbh->quote($value);
8751
8752     #exact
8753     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8754     $sql .= " (    LOWER(last)          = $q_value
8755                 OR LOWER(company)       = $q_value
8756                 OR LOWER(ship_last)     = $q_value
8757                 OR LOWER(ship_company)  = $q_value
8758             ";
8759     $sql .= "   OR LOWER(address1)      = $q_value
8760                 OR LOWER(ship_address1) = $q_value
8761             "
8762       if $conf->exists('address1-search');
8763     $sql .= " )";
8764
8765     push @cust_main, qsearch( {
8766       'table'     => 'cust_main',
8767       'hashref'   => \%options,
8768       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8769     } );
8770
8771     #no exact match, trying substring/fuzzy
8772     #always do substring & fuzzy (unless they're explicity config'ed off)
8773     #getting complaints searches are not returning enough
8774     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8775
8776       #still some false laziness w/search_sql (was search/cust_main.cgi)
8777
8778       #substring
8779
8780       my @hashrefs = (
8781         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
8782         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
8783       );
8784
8785       if ( $first && $last ) {
8786
8787         push @hashrefs,
8788           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
8789             'last'         => { op=>'ILIKE', value=>"%$last%" },
8790           },
8791           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
8792             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
8793           },
8794         ;
8795
8796       } else {
8797
8798         push @hashrefs,
8799           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
8800           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
8801         ;
8802       }
8803
8804       if ( $conf->exists('address1-search') ) {
8805         push @hashrefs,
8806           { 'address1'      => { op=>'ILIKE', value=>"%$value%" }, },
8807           { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, },
8808         ;
8809       }
8810
8811       foreach my $hashref ( @hashrefs ) {
8812
8813         push @cust_main, qsearch( {
8814           'table'     => 'cust_main',
8815           'hashref'   => { %$hashref,
8816                            %options,
8817                          },
8818           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
8819         } );
8820
8821       }
8822
8823       #fuzzy
8824       my @fuzopts = (
8825         \%options,                #hashref
8826         '',                       #select
8827         " AND $agentnums_sql",    #extra_sql  #agent virtualization
8828       );
8829
8830       if ( $first && $last ) {
8831         push @cust_main, FS::cust_main->fuzzy_search(
8832           { 'last'   => $last,    #fuzzy hashref
8833             'first'  => $first }, #
8834           @fuzopts
8835         );
8836       }
8837       foreach my $field ( 'last', 'company' ) {
8838         push @cust_main,
8839           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
8840       }
8841       if ( $conf->exists('address1-search') ) {
8842         push @cust_main,
8843           FS::cust_main->fuzzy_search( { 'address1' => $value }, @fuzopts );
8844       }
8845
8846     }
8847
8848   }
8849
8850   #eliminate duplicates
8851   my %saw = ();
8852   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8853
8854   @cust_main;
8855
8856 }
8857
8858 =item email_search
8859
8860 Accepts the following options: I<email>, the email address to search for.  The
8861 email address will be searched for as an email invoice destination and as an
8862 svc_acct account.
8863
8864 #Any additional options are treated as an additional qualifier on the search
8865 #(i.e. I<agentnum>).
8866
8867 Returns a (possibly empty) array of FS::cust_main objects (but usually just
8868 none or one).
8869
8870 =cut
8871
8872 sub email_search {
8873   my %options = @_;
8874
8875   local($DEBUG) = 1;
8876
8877   my $email = delete $options{'email'};
8878
8879   #we're only being used by RT at the moment... no agent virtualization yet
8880   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8881
8882   my @cust_main = ();
8883
8884   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
8885
8886     my ( $user, $domain ) = ( $1, $2 );
8887
8888     warn "$me smart_search: searching for $user in domain $domain"
8889       if $DEBUG;
8890
8891     push @cust_main,
8892       map $_->cust_main,
8893           qsearch( {
8894                      'table'     => 'cust_main_invoice',
8895                      'hashref'   => { 'dest' => $email },
8896                    }
8897                  );
8898
8899     push @cust_main,
8900       map  $_->cust_main,
8901       grep $_,
8902       map  $_->cust_svc->cust_pkg,
8903           qsearch( {
8904                      'table'     => 'svc_acct',
8905                      'hashref'   => { 'username' => $user, },
8906                      'extra_sql' =>
8907                        'AND ( SELECT domain FROM svc_domain
8908                                 WHERE svc_acct.domsvc = svc_domain.svcnum
8909                             ) = '. dbh->quote($domain),
8910                    }
8911                  );
8912   }
8913
8914   my %saw = ();
8915   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8916
8917   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8918     if $DEBUG;
8919
8920   @cust_main;
8921
8922 }
8923
8924 =item check_and_rebuild_fuzzyfiles
8925
8926 =cut
8927
8928 sub check_and_rebuild_fuzzyfiles {
8929   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8930   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8931 }
8932
8933 =item rebuild_fuzzyfiles
8934
8935 =cut
8936
8937 sub rebuild_fuzzyfiles {
8938
8939   use Fcntl qw(:flock);
8940
8941   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8942   mkdir $dir, 0700 unless -d $dir;
8943
8944   foreach my $fuzzy ( @fuzzyfields ) {
8945
8946     open(LOCK,">>$dir/cust_main.$fuzzy")
8947       or die "can't open $dir/cust_main.$fuzzy: $!";
8948     flock(LOCK,LOCK_EX)
8949       or die "can't lock $dir/cust_main.$fuzzy: $!";
8950
8951     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8952       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8953
8954     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8955       my $sth = dbh->prepare("SELECT $field FROM cust_main".
8956                              " WHERE $field != '' AND $field IS NOT NULL");
8957       $sth->execute or die $sth->errstr;
8958
8959       while ( my $row = $sth->fetchrow_arrayref ) {
8960         print CACHE $row->[0]. "\n";
8961       }
8962
8963     }
8964
8965     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8966
8967     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8968     close LOCK;
8969   }
8970
8971 }
8972
8973 =item all_X
8974
8975 =cut
8976
8977 sub all_X {
8978   my( $self, $field ) = @_;
8979   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8980   open(CACHE,"<$dir/cust_main.$field")
8981     or die "can't open $dir/cust_main.$field: $!";
8982   my @array = map { chomp; $_; } <CACHE>;
8983   close CACHE;
8984   \@array;
8985 }
8986
8987 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
8988
8989 =cut
8990
8991 sub append_fuzzyfiles {
8992   #my( $first, $last, $company ) = @_;
8993
8994   &check_and_rebuild_fuzzyfiles;
8995
8996   use Fcntl qw(:flock);
8997
8998   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8999
9000   foreach my $field (@fuzzyfields) {
9001     my $value = shift;
9002
9003     if ( $value ) {
9004
9005       open(CACHE,">>$dir/cust_main.$field")
9006         or die "can't open $dir/cust_main.$field: $!";
9007       flock(CACHE,LOCK_EX)
9008         or die "can't lock $dir/cust_main.$field: $!";
9009
9010       print CACHE "$value\n";
9011
9012       flock(CACHE,LOCK_UN)
9013         or die "can't unlock $dir/cust_main.$field: $!";
9014       close CACHE;
9015     }
9016
9017   }
9018
9019   1;
9020 }
9021
9022 =item batch_charge
9023
9024 =cut
9025
9026 sub batch_charge {
9027   my $param = shift;
9028   #warn join('-',keys %$param);
9029   my $fh = $param->{filehandle};
9030   my @fields = @{$param->{fields}};
9031
9032   eval "use Text::CSV_XS;";
9033   die $@ if $@;
9034
9035   my $csv = new Text::CSV_XS;
9036   #warn $csv;
9037   #warn $fh;
9038
9039   my $imported = 0;
9040   #my $columns;
9041
9042   local $SIG{HUP} = 'IGNORE';
9043   local $SIG{INT} = 'IGNORE';
9044   local $SIG{QUIT} = 'IGNORE';
9045   local $SIG{TERM} = 'IGNORE';
9046   local $SIG{TSTP} = 'IGNORE';
9047   local $SIG{PIPE} = 'IGNORE';
9048
9049   my $oldAutoCommit = $FS::UID::AutoCommit;
9050   local $FS::UID::AutoCommit = 0;
9051   my $dbh = dbh;
9052
9053   #while ( $columns = $csv->getline($fh) ) {
9054   my $line;
9055   while ( defined($line=<$fh>) ) {
9056
9057     $csv->parse($line) or do {
9058       $dbh->rollback if $oldAutoCommit;
9059       return "can't parse: ". $csv->error_input();
9060     };
9061
9062     my @columns = $csv->fields();
9063     #warn join('-',@columns);
9064
9065     my %row = ();
9066     foreach my $field ( @fields ) {
9067       $row{$field} = shift @columns;
9068     }
9069
9070     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
9071     unless ( $cust_main ) {
9072       $dbh->rollback if $oldAutoCommit;
9073       return "unknown custnum $row{'custnum'}";
9074     }
9075
9076     if ( $row{'amount'} > 0 ) {
9077       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
9078       if ( $error ) {
9079         $dbh->rollback if $oldAutoCommit;
9080         return $error;
9081       }
9082       $imported++;
9083     } elsif ( $row{'amount'} < 0 ) {
9084       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
9085                                       $row{'pkg'}                         );
9086       if ( $error ) {
9087         $dbh->rollback if $oldAutoCommit;
9088         return $error;
9089       }
9090       $imported++;
9091     } else {
9092       #hmm?
9093     }
9094
9095   }
9096
9097   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
9098
9099   return "Empty file!" unless $imported;
9100
9101   ''; #no error
9102
9103 }
9104
9105 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
9106
9107 Sends a templated email notification to the customer (see L<Text::Template>).
9108
9109 OPTIONS is a hash and may include
9110
9111 I<from> - the email sender (default is invoice_from)
9112
9113 I<to> - comma-separated scalar or arrayref of recipients
9114    (default is invoicing_list)
9115
9116 I<subject> - The subject line of the sent email notification
9117    (default is "Notice from company_name")
9118
9119 I<extra_fields> - a hashref of name/value pairs which will be substituted
9120    into the template
9121
9122 The following variables are vavailable in the template.
9123
9124 I<$first> - the customer first name
9125 I<$last> - the customer last name
9126 I<$company> - the customer company
9127 I<$payby> - a description of the method of payment for the customer
9128             # would be nice to use FS::payby::shortname
9129 I<$payinfo> - the account information used to collect for this customer
9130 I<$expdate> - the expiration of the customer payment in seconds from epoch
9131
9132 =cut
9133
9134 sub notify {
9135   my ($self, $template, %options) = @_;
9136
9137   return unless $conf->exists($template);
9138
9139   my $from = $conf->config('invoice_from', $self->agentnum)
9140     if $conf->exists('invoice_from', $self->agentnum);
9141   $from = $options{from} if exists($options{from});
9142
9143   my $to = join(',', $self->invoicing_list_emailonly);
9144   $to = $options{to} if exists($options{to});
9145
9146   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
9147     if $conf->exists('company_name', $self->agentnum);
9148   $subject = $options{subject} if exists($options{subject});
9149
9150   my $notify_template = new Text::Template (TYPE => 'ARRAY',
9151                                             SOURCE => [ map "$_\n",
9152                                               $conf->config($template)]
9153                                            )
9154     or die "can't create new Text::Template object: Text::Template::ERROR";
9155   $notify_template->compile()
9156     or die "can't compile template: Text::Template::ERROR";
9157
9158   $FS::notify_template::_template::company_name =
9159     $conf->config('company_name', $self->agentnum);
9160   $FS::notify_template::_template::company_address =
9161     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
9162
9163   my $paydate = $self->paydate || '2037-12-31';
9164   $FS::notify_template::_template::first = $self->first;
9165   $FS::notify_template::_template::last = $self->last;
9166   $FS::notify_template::_template::company = $self->company;
9167   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
9168   my $payby = $self->payby;
9169   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
9170   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
9171
9172   #credit cards expire at the end of the month/year of their exp date
9173   if ($payby eq 'CARD' || $payby eq 'DCRD') {
9174     $FS::notify_template::_template::payby = 'credit card';
9175     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
9176     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
9177     $expire_time--;
9178   }elsif ($payby eq 'COMP') {
9179     $FS::notify_template::_template::payby = 'complimentary account';
9180   }else{
9181     $FS::notify_template::_template::payby = 'current method';
9182   }
9183   $FS::notify_template::_template::expdate = $expire_time;
9184
9185   for (keys %{$options{extra_fields}}){
9186     no strict "refs";
9187     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
9188   }
9189
9190   send_email(from => $from,
9191              to => $to,
9192              subject => $subject,
9193              body => $notify_template->fill_in( PACKAGE =>
9194                                                 'FS::notify_template::_template'                                              ),
9195             );
9196
9197 }
9198
9199 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
9200
9201 Generates a templated notification to the customer (see L<Text::Template>).
9202
9203 OPTIONS is a hash and may include
9204
9205 I<extra_fields> - a hashref of name/value pairs which will be substituted
9206    into the template.  These values may override values mentioned below
9207    and those from the customer record.
9208
9209 The following variables are available in the template instead of or in addition
9210 to the fields of the customer record.
9211
9212 I<$payby> - a description of the method of payment for the customer
9213             # would be nice to use FS::payby::shortname
9214 I<$payinfo> - the masked account information used to collect for this customer
9215 I<$expdate> - the expiration of the customer payment method in seconds from epoch
9216 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
9217
9218 =cut
9219
9220 sub generate_letter {
9221   my ($self, $template, %options) = @_;
9222
9223   return unless $conf->exists($template);
9224
9225   my $letter_template = new Text::Template
9226                         ( TYPE       => 'ARRAY',
9227                           SOURCE     => [ map "$_\n", $conf->config($template)],
9228                           DELIMITERS => [ '[@--', '--@]' ],
9229                         )
9230     or die "can't create new Text::Template object: Text::Template::ERROR";
9231
9232   $letter_template->compile()
9233     or die "can't compile template: Text::Template::ERROR";
9234
9235   my %letter_data = map { $_ => $self->$_ } $self->fields;
9236   $letter_data{payinfo} = $self->mask_payinfo;
9237
9238   #my $paydate = $self->paydate || '2037-12-31';
9239   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
9240
9241   my $payby = $self->payby;
9242   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
9243   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
9244
9245   #credit cards expire at the end of the month/year of their exp date
9246   if ($payby eq 'CARD' || $payby eq 'DCRD') {
9247     $letter_data{payby} = 'credit card';
9248     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
9249     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
9250     $expire_time--;
9251   }elsif ($payby eq 'COMP') {
9252     $letter_data{payby} = 'complimentary account';
9253   }else{
9254     $letter_data{payby} = 'current method';
9255   }
9256   $letter_data{expdate} = $expire_time;
9257
9258   for (keys %{$options{extra_fields}}){
9259     $letter_data{$_} = $options{extra_fields}->{$_};
9260   }
9261
9262   unless(exists($letter_data{returnaddress})){
9263     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
9264                                                   $self->agent_template)
9265                      );
9266     if ( length($retadd) ) {
9267       $letter_data{returnaddress} = $retadd;
9268     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
9269       $letter_data{returnaddress} =
9270         join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
9271                           $conf->config('company_address', $self->agentnum)
9272         );
9273     } else {
9274       $letter_data{returnaddress} = '~';
9275     }
9276   }
9277
9278   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
9279
9280   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
9281
9282   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
9283   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
9284                            DIR      => $dir,
9285                            SUFFIX   => '.tex',
9286                            UNLINK   => 0,
9287                          ) or die "can't open temp file: $!\n";
9288
9289   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
9290   close $fh;
9291   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
9292   return $1;
9293 }
9294
9295 =item print_ps TEMPLATE
9296
9297 Returns an postscript letter filled in from TEMPLATE, as a scalar.
9298
9299 =cut
9300
9301 sub print_ps {
9302   my $self = shift;
9303   my $file = $self->generate_letter(@_);
9304   FS::Misc::generate_ps($file);
9305 }
9306
9307 =item print TEMPLATE
9308
9309 Prints the filled in template.
9310
9311 TEMPLATE is the name of a L<Text::Template> to fill in and print.
9312
9313 =cut
9314
9315 sub queueable_print {
9316   my %opt = @_;
9317
9318   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
9319     or die "invalid customer number: " . $opt{custvnum};
9320
9321   my $error = $self->print( $opt{template} );
9322   die $error if $error;
9323 }
9324
9325 sub print {
9326   my ($self, $template) = (shift, shift);
9327   do_print [ $self->print_ps($template) ];
9328 }
9329
9330 #these three subs should just go away once agent stuff is all config overrides
9331
9332 sub agent_template {
9333   my $self = shift;
9334   $self->_agent_plandata('agent_templatename');
9335 }
9336
9337 sub agent_invoice_from {
9338   my $self = shift;
9339   $self->_agent_plandata('agent_invoice_from');
9340 }
9341
9342 sub _agent_plandata {
9343   my( $self, $option ) = @_;
9344
9345   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
9346   #agent-specific Conf
9347
9348   use FS::part_event::Condition;
9349
9350   my $agentnum = $self->agentnum;
9351
9352   my $regexp = '';
9353   if ( driver_name =~ /^Pg/i ) {
9354     $regexp = '~';
9355   } elsif ( driver_name =~ /^mysql/i ) {
9356     $regexp = 'REGEXP';
9357   } else {
9358     die "don't know how to use regular expressions in ". driver_name. " databases";
9359   }
9360
9361   my $part_event_option =
9362     qsearchs({
9363       'select'    => 'part_event_option.*',
9364       'table'     => 'part_event_option',
9365       'addl_from' => q{
9366         LEFT JOIN part_event USING ( eventpart )
9367         LEFT JOIN part_event_option AS peo_agentnum
9368           ON ( part_event.eventpart = peo_agentnum.eventpart
9369                AND peo_agentnum.optionname = 'agentnum'
9370                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
9371              )
9372         LEFT JOIN part_event_condition
9373           ON ( part_event.eventpart = part_event_condition.eventpart
9374                AND part_event_condition.conditionname = 'cust_bill_age'
9375              )
9376         LEFT JOIN part_event_condition_option
9377           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
9378                AND part_event_condition_option.optionname = 'age'
9379              )
9380       },
9381       #'hashref'   => { 'optionname' => $option },
9382       #'hashref'   => { 'part_event_option.optionname' => $option },
9383       'extra_sql' =>
9384         " WHERE part_event_option.optionname = ". dbh->quote($option).
9385         " AND action = 'cust_bill_send_agent' ".
9386         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
9387         " AND peo_agentnum.optionname = 'agentnum' ".
9388         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
9389         " ORDER BY
9390            CASE WHEN part_event_condition_option.optionname IS NULL
9391            THEN -1
9392            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
9393         " END
9394           , part_event.weight".
9395         " LIMIT 1"
9396     });
9397
9398   unless ( $part_event_option ) {
9399     return $self->agent->invoice_template || ''
9400       if $option eq 'agent_templatename';
9401     return '';
9402   }
9403
9404   $part_event_option->optionvalue;
9405
9406 }
9407
9408 sub queued_bill {
9409   ## actual sub, not a method, designed to be called from the queue.
9410   ## sets up the customer, and calls the bill_and_collect
9411   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
9412   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
9413       $cust_main->bill_and_collect(
9414         %args,
9415       );
9416 }
9417
9418 sub _upgrade_data { #class method
9419   my ($class, %opts) = @_;
9420
9421   my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
9422   my $sth = dbh->prepare($sql) or die dbh->errstr;
9423   $sth->execute or die $sth->errstr;
9424
9425 }
9426
9427 =back
9428
9429 =head1 BUGS
9430
9431 The delete method.
9432
9433 The delete method should possibly take an FS::cust_main object reference
9434 instead of a scalar customer number.
9435
9436 Bill and collect options should probably be passed as references instead of a
9437 list.
9438
9439 There should probably be a configuration file with a list of allowed credit
9440 card types.
9441
9442 No multiple currency support (probably a larger project than just this module).
9443
9444 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
9445
9446 Birthdates rely on negative epoch values.
9447
9448 The payby for card/check batches is broken.  With mixed batching, bad
9449 things will happen.
9450
9451 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
9452
9453 =head1 SEE ALSO
9454
9455 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
9456 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
9457 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
9458
9459 =cut
9460
9461 1;
9462