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