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