FS/FS/cust_main.pm

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