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