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