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