FS/FS/cust_main.pm

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