FS/FS/cust_main.pm

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