FS/FS/cust_main.pm

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