FS/FS/cust_main.pm

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