FS/FS/cust_main.pm

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