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