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