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