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