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