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