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