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