FS/FS/cust_main.pm

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