FS/FS/cust_main.pm

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