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