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 paydate_monthyear
6036
6037 Returns a two-element list consisting of the month and year of this customer's
6038 paydate (credit card expiration date for CARD customers)
6039
6040 =cut
6041
6042 sub paydate_monthyear {
6043   my $self = shift;
6044   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6045     ( $2, $1 );
6046   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6047     ( $1, $3 );
6048   } else {
6049     ('', '');
6050   }
6051 }
6052
6053 =item invoicing_list [ ARRAYREF ]
6054
6055 If an arguement is given, sets these email addresses as invoice recipients
6056 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
6057 (except as warnings), so use check_invoicing_list first.
6058
6059 Returns a list of email addresses (with svcnum entries expanded).
6060
6061 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
6062 check it without disturbing anything by passing nothing.
6063
6064 This interface may change in the future.
6065
6066 =cut
6067
6068 sub invoicing_list {
6069   my( $self, $arrayref ) = @_;
6070
6071   if ( $arrayref ) {
6072     my @cust_main_invoice;
6073     if ( $self->custnum ) {
6074       @cust_main_invoice =
6075         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6076     } else {
6077       @cust_main_invoice = ();
6078     }
6079     foreach my $cust_main_invoice ( @cust_main_invoice ) {
6080       #warn $cust_main_invoice->destnum;
6081       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6082         #warn $cust_main_invoice->destnum;
6083         my $error = $cust_main_invoice->delete;
6084         warn $error if $error;
6085       }
6086     }
6087     if ( $self->custnum ) {
6088       @cust_main_invoice =
6089         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6090     } else {
6091       @cust_main_invoice = ();
6092     }
6093     my %seen = map { $_->address => 1 } @cust_main_invoice;
6094     foreach my $address ( @{$arrayref} ) {
6095       next if exists $seen{$address} && $seen{$address};
6096       $seen{$address} = 1;
6097       my $cust_main_invoice = new FS::cust_main_invoice ( {
6098         'custnum' => $self->custnum,
6099         'dest'    => $address,
6100       } );
6101       my $error = $cust_main_invoice->insert;
6102       warn $error if $error;
6103     }
6104   }
6105
6106   if ( $self->custnum ) {
6107     map { $_->address }
6108       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6109   } else {
6110     ();
6111   }
6112
6113 }
6114
6115 =item check_invoicing_list ARRAYREF
6116
6117 Checks these arguements as valid input for the invoicing_list method.  If there
6118 is an error, returns the error, otherwise returns false.
6119
6120 =cut
6121
6122 sub check_invoicing_list {
6123   my( $self, $arrayref ) = @_;
6124
6125   foreach my $address ( @$arrayref ) {
6126
6127     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6128       return 'Can\'t add FAX invoice destination with a blank FAX number.';
6129     }
6130
6131     my $cust_main_invoice = new FS::cust_main_invoice ( {
6132       'custnum' => $self->custnum,
6133       'dest'    => $address,
6134     } );
6135     my $error = $self->custnum
6136                 ? $cust_main_invoice->check
6137                 : $cust_main_invoice->checkdest
6138     ;
6139     return $error if $error;
6140
6141   }
6142
6143   return "Email address required"
6144     if $conf->exists('cust_main-require_invoicing_list_email')
6145     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6146
6147   '';
6148 }
6149
6150 =item set_default_invoicing_list
6151
6152 Sets the invoicing list to all accounts associated with this customer,
6153 overwriting any previous invoicing list.
6154
6155 =cut
6156
6157 sub set_default_invoicing_list {
6158   my $self = shift;
6159   $self->invoicing_list($self->all_emails);
6160 }
6161
6162 =item all_emails
6163
6164 Returns the email addresses of all accounts provisioned for this customer.
6165
6166 =cut
6167
6168 sub all_emails {
6169   my $self = shift;
6170   my %list;
6171   foreach my $cust_pkg ( $self->all_pkgs ) {
6172     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6173     my @svc_acct =
6174       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6175         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6176           @cust_svc;
6177     $list{$_}=1 foreach map { $_->email } @svc_acct;
6178   }
6179   keys %list;
6180 }
6181
6182 =item invoicing_list_addpost
6183
6184 Adds postal invoicing to this customer.  If this customer is already configured
6185 to receive postal invoices, does nothing.
6186
6187 =cut
6188
6189 sub invoicing_list_addpost {
6190   my $self = shift;
6191   return if grep { $_ eq 'POST' } $self->invoicing_list;
6192   my @invoicing_list = $self->invoicing_list;
6193   push @invoicing_list, 'POST';
6194   $self->invoicing_list(\@invoicing_list);
6195 }
6196
6197 =item invoicing_list_emailonly
6198
6199 Returns the list of email invoice recipients (invoicing_list without non-email
6200 destinations such as POST and FAX).
6201
6202 =cut
6203
6204 sub invoicing_list_emailonly {
6205   my $self = shift;
6206   warn "$me invoicing_list_emailonly called"
6207     if $DEBUG;
6208   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6209 }
6210
6211 =item invoicing_list_emailonly_scalar
6212
6213 Returns the list of email invoice recipients (invoicing_list without non-email
6214 destinations such as POST and FAX) as a comma-separated scalar.
6215
6216 =cut
6217
6218 sub invoicing_list_emailonly_scalar {
6219   my $self = shift;
6220   warn "$me invoicing_list_emailonly_scalar called"
6221     if $DEBUG;
6222   join(', ', $self->invoicing_list_emailonly);
6223 }
6224
6225 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6226
6227 Returns an array of customers referred by this customer (referral_custnum set
6228 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
6229 customers referred by customers referred by this customer and so on, inclusive.
6230 The default behavior is DEPTH 1 (no recursion).
6231
6232 =cut
6233
6234 sub referral_cust_main {
6235   my $self = shift;
6236   my $depth = @_ ? shift : 1;
6237   my $exclude = @_ ? shift : {};
6238
6239   my @cust_main =
6240     map { $exclude->{$_->custnum}++; $_; }
6241       grep { ! $exclude->{ $_->custnum } }
6242         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6243
6244   if ( $depth > 1 ) {
6245     push @cust_main,
6246       map { $_->referral_cust_main($depth-1, $exclude) }
6247         @cust_main;
6248   }
6249
6250   @cust_main;
6251 }
6252
6253 =item referral_cust_main_ncancelled
6254
6255 Same as referral_cust_main, except only returns customers with uncancelled
6256 packages.
6257
6258 =cut
6259
6260 sub referral_cust_main_ncancelled {
6261   my $self = shift;
6262   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6263 }
6264
6265 =item referral_cust_pkg [ DEPTH ]
6266
6267 Like referral_cust_main, except returns a flat list of all unsuspended (and
6268 uncancelled) packages for each customer.  The number of items in this list may
6269 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6270
6271 =cut
6272
6273 sub referral_cust_pkg {
6274   my $self = shift;
6275   my $depth = @_ ? shift : 1;
6276
6277   map { $_->unsuspended_pkgs }
6278     grep { $_->unsuspended_pkgs }
6279       $self->referral_cust_main($depth);
6280 }
6281
6282 =item referring_cust_main
6283
6284 Returns the single cust_main record for the customer who referred this customer
6285 (referral_custnum), or false.
6286
6287 =cut
6288
6289 sub referring_cust_main {
6290   my $self = shift;
6291   return '' unless $self->referral_custnum;
6292   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6293 }
6294
6295 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6296
6297 Applies a credit to this customer.  If there is an error, returns the error,
6298 otherwise returns false.
6299
6300 REASON can be a text string, an FS::reason object, or a scalar reference to
6301 a reasonnum.  If a text string, it will be automatically inserted as a new
6302 reason, and a 'reason_type' option must be passed to indicate the
6303 FS::reason_type for the new reason.
6304
6305 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6306
6307 Any other options are passed to FS::cust_credit::insert.
6308
6309 =cut
6310
6311 sub credit {
6312   my( $self, $amount, $reason, %options ) = @_;
6313
6314   my $cust_credit = new FS::cust_credit {
6315     'custnum' => $self->custnum,
6316     'amount'  => $amount,
6317   };
6318
6319   if ( ref($reason) ) {
6320
6321     if ( ref($reason) eq 'SCALAR' ) {
6322       $cust_credit->reasonnum( $$reason );
6323     } else {
6324       $cust_credit->reasonnum( $reason->reasonnum );
6325     }
6326
6327   } else {
6328     $cust_credit->set('reason', $reason)
6329   }
6330
6331   $cust_credit->addlinfo( delete $options{'addlinfo'} )
6332     if exists($options{'addlinfo'});
6333
6334   $cust_credit->insert(%options);
6335
6336 }
6337
6338 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6339
6340 Creates a one-time charge for this customer.  If there is an error, returns
6341 the error, otherwise returns false.
6342
6343 =cut
6344
6345 sub charge {
6346   my $self = shift;
6347   my ( $amount, $quantity, $pkg, $comment, $classnum, $additional );
6348   my ( $setuptax, $taxclass );   #internal taxes
6349   my ( $taxproduct, $override ); #vendor (CCH) taxes
6350   if ( ref( $_[0] ) ) {
6351     $amount     = $_[0]->{amount};
6352     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6353     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6354     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
6355                                            : '$'. sprintf("%.2f",$amount);
6356     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6357     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6358     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6359     $additional = $_[0]->{additional};
6360     $taxproduct = $_[0]->{taxproductnum};
6361     $override   = { '' => $_[0]->{tax_override} };
6362   }else{
6363     $amount     = shift;
6364     $quantity   = 1;
6365     $pkg        = @_ ? shift : 'One-time charge';
6366     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
6367     $setuptax   = '';
6368     $taxclass   = @_ ? shift : '';
6369     $additional = [];
6370   }
6371
6372   local $SIG{HUP} = 'IGNORE';
6373   local $SIG{INT} = 'IGNORE';
6374   local $SIG{QUIT} = 'IGNORE';
6375   local $SIG{TERM} = 'IGNORE';
6376   local $SIG{TSTP} = 'IGNORE';
6377   local $SIG{PIPE} = 'IGNORE';
6378
6379   my $oldAutoCommit = $FS::UID::AutoCommit;
6380   local $FS::UID::AutoCommit = 0;
6381   my $dbh = dbh;
6382
6383   my $part_pkg = new FS::part_pkg ( {
6384     'pkg'           => $pkg,
6385     'comment'       => $comment,
6386     'plan'          => 'flat',
6387     'freq'          => 0,
6388     'disabled'      => 'Y',
6389     'classnum'      => $classnum ? $classnum : '',
6390     'setuptax'      => $setuptax,
6391     'taxclass'      => $taxclass,
6392     'taxproductnum' => $taxproduct,
6393   } );
6394
6395   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6396                         ( 0 .. @$additional - 1 )
6397                   ),
6398                   'additional_count' => scalar(@$additional),
6399                   'setup_fee' => $amount,
6400                 );
6401
6402   my $error = $part_pkg->insert( options       => \%options,
6403                                  tax_overrides => $override,
6404                                );
6405   if ( $error ) {
6406     $dbh->rollback if $oldAutoCommit;
6407     return $error;
6408   }
6409
6410   my $pkgpart = $part_pkg->pkgpart;
6411   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6412   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6413     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6414     $error = $type_pkgs->insert;
6415     if ( $error ) {
6416       $dbh->rollback if $oldAutoCommit;
6417       return $error;
6418     }
6419   }
6420
6421   my $cust_pkg = new FS::cust_pkg ( {
6422     'custnum'  => $self->custnum,
6423     'pkgpart'  => $pkgpart,
6424     'quantity' => $quantity,
6425   } );
6426
6427   $error = $cust_pkg->insert;
6428   if ( $error ) {
6429     $dbh->rollback if $oldAutoCommit;
6430     return $error;
6431   }
6432
6433   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6434   '';
6435
6436 }
6437
6438 #=item charge_postal_fee
6439 #
6440 #Applies a one time charge this customer.  If there is an error,
6441 #returns the error, returns the cust_pkg charge object or false
6442 #if there was no charge.
6443 #
6444 #=cut
6445 #
6446 # This should be a customer event.  For that to work requires that bill
6447 # also be a customer event.
6448
6449 sub charge_postal_fee {
6450   my $self = shift;
6451
6452   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
6453   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
6454
6455   my $cust_pkg = new FS::cust_pkg ( {
6456     'custnum'  => $self->custnum,
6457     'pkgpart'  => $pkgpart,
6458     'quantity' => 1,
6459   } );
6460
6461   my $error = $cust_pkg->insert;
6462   $error ? $error : $cust_pkg;
6463 }
6464
6465 =item cust_bill
6466
6467 Returns all the invoices (see L<FS::cust_bill>) for this customer.
6468
6469 =cut
6470
6471 sub cust_bill {
6472   my $self = shift;
6473   sort { $a->_date <=> $b->_date }
6474     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6475 }
6476
6477 =item open_cust_bill
6478
6479 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
6480 customer.
6481
6482 =cut
6483
6484 sub open_cust_bill {
6485   my $self = shift;
6486   grep { $_->owed > 0 } $self->cust_bill;
6487 }
6488
6489 =item cust_credit
6490
6491 Returns all the credits (see L<FS::cust_credit>) for this customer.
6492
6493 =cut
6494
6495 sub cust_credit {
6496   my $self = shift;
6497   sort { $a->_date <=> $b->_date }
6498     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
6499 }
6500
6501 =item cust_pay
6502
6503 Returns all the payments (see L<FS::cust_pay>) for this customer.
6504
6505 =cut
6506
6507 sub cust_pay {
6508   my $self = shift;
6509   sort { $a->_date <=> $b->_date }
6510     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
6511 }
6512
6513 =item cust_pay_void
6514
6515 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
6516
6517 =cut
6518
6519 sub cust_pay_void {
6520   my $self = shift;
6521   sort { $a->_date <=> $b->_date }
6522     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
6523 }
6524
6525 =item cust_pay_batch
6526
6527 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
6528
6529 =cut
6530
6531 sub cust_pay_batch {
6532   my $self = shift;
6533   sort { $a->_date <=> $b->_date }
6534     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
6535 }
6536
6537 =item cust_pay_pending
6538
6539 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
6540 (without status "done").
6541
6542 =cut
6543
6544 sub cust_pay_pending {
6545   my $self = shift;
6546   return $self->num_cust_pay_pending unless wantarray;
6547   sort { $a->_date <=> $b->_date }
6548     qsearch( 'cust_pay_pending', {
6549                                    'custnum' => $self->custnum,
6550                                    'status'  => { op=>'!=', value=>'done' },
6551                                  },
6552            );
6553 }
6554
6555 =item num_cust_pay_pending
6556
6557 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
6558 customer (without status "done").  Also called automatically when the
6559 cust_pay_pending method is used in a scalar context.
6560
6561 =cut
6562
6563 sub num_cust_pay_pending {
6564   my $self = shift;
6565   my $sql = " SELECT COUNT(*) FROM cust_pay_pending ".
6566             "   WHERE custnum = ? AND status != 'done' ";
6567   my $sth = dbh->prepare($sql) or die dbh->errstr;
6568   $sth->execute($self->custnum) or die $sth->errstr;
6569   $sth->fetchrow_arrayref->[0];
6570 }
6571
6572 =item cust_refund
6573
6574 Returns all the refunds (see L<FS::cust_refund>) for this customer.
6575
6576 =cut
6577
6578 sub cust_refund {
6579   my $self = shift;
6580   sort { $a->_date <=> $b->_date }
6581     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
6582 }
6583
6584 =item display_custnum
6585
6586 Returns the displayed customer number for this customer: agent_custid if
6587 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
6588
6589 =cut
6590
6591 sub display_custnum {
6592   my $self = shift;
6593   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
6594     return $self->agent_custid;
6595   } else {
6596     return $self->custnum;
6597   }
6598 }
6599
6600 =item name
6601
6602 Returns a name string for this customer, either "Company (Last, First)" or
6603 "Last, First".
6604
6605 =cut
6606
6607 sub name {
6608   my $self = shift;
6609   my $name = $self->contact;
6610   $name = $self->company. " ($name)" if $self->company;
6611   $name;
6612 }
6613
6614 =item ship_name
6615
6616 Returns a name string for this (service/shipping) contact, either
6617 "Company (Last, First)" or "Last, First".
6618
6619 =cut
6620
6621 sub ship_name {
6622   my $self = shift;
6623   if ( $self->get('ship_last') ) {
6624     my $name = $self->ship_contact;
6625     $name = $self->ship_company. " ($name)" if $self->ship_company;
6626     $name;
6627   } else {
6628     $self->name;
6629   }
6630 }
6631
6632 =item name_short
6633
6634 Returns a name string for this customer, either "Company" or "First Last".
6635
6636 =cut
6637
6638 sub name_short {
6639   my $self = shift;
6640   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
6641 }
6642
6643 =item ship_name_short
6644
6645 Returns a name string for this (service/shipping) contact, either "Company"
6646 or "First Last".
6647
6648 =cut
6649
6650 sub ship_name_short {
6651   my $self = shift;
6652   if ( $self->get('ship_last') ) {
6653     $self->ship_company !~ /^\s*$/
6654       ? $self->ship_company
6655       : $self->ship_contact_firstlast;
6656   } else {
6657     $self->name_company_or_firstlast;
6658   }
6659 }
6660
6661 =item contact
6662
6663 Returns this customer's full (billing) contact name only, "Last, First"
6664
6665 =cut
6666
6667 sub contact {
6668   my $self = shift;
6669   $self->get('last'). ', '. $self->first;
6670 }
6671
6672 =item ship_contact
6673
6674 Returns this customer's full (shipping) contact name only, "Last, First"
6675
6676 =cut
6677
6678 sub ship_contact {
6679   my $self = shift;
6680   $self->get('ship_last')
6681     ? $self->get('ship_last'). ', '. $self->ship_first
6682     : $self->contact;
6683 }
6684
6685 =item contact_firstlast
6686
6687 Returns this customers full (billing) contact name only, "First Last".
6688
6689 =cut
6690
6691 sub contact_firstlast {
6692   my $self = shift;
6693   $self->first. ' '. $self->get('last');
6694 }
6695
6696 =item ship_contact_firstlast
6697
6698 Returns this customer's full (shipping) contact name only, "First Last".
6699
6700 =cut
6701
6702 sub ship_contact_firstlast {
6703   my $self = shift;
6704   $self->get('ship_last')
6705     ? $self->first. ' '. $self->get('ship_last')
6706     : $self->contact_firstlast;
6707 }
6708
6709 =item country_full
6710
6711 Returns this customer's full country name
6712
6713 =cut
6714
6715 sub country_full {
6716   my $self = shift;
6717   code2country($self->country);
6718 }
6719
6720 =item geocode DATA_VENDOR
6721
6722 Returns a value for the customer location as encoded by DATA_VENDOR.
6723 Currently this only makes sense for "CCH" as DATA_VENDOR.
6724
6725 =cut
6726
6727 sub geocode {
6728   my ($self, $data_vendor) = (shift, shift);  #always cch for now
6729
6730   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
6731   return $geocode if $geocode;
6732
6733   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
6734                ? 'ship_'
6735                : '';
6736
6737   my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
6738     if $self->country eq 'US';
6739
6740   #CCH specific location stuff
6741   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
6742
6743   my @cust_tax_location =
6744     qsearch( {
6745                'table'     => 'cust_tax_location',
6746                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
6747                'extra_sql' => $extra_sql,
6748                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
6749              }
6750            );
6751   $geocode = $cust_tax_location[0]->geocode
6752     if scalar(@cust_tax_location);
6753
6754   $geocode;
6755 }
6756
6757 =item cust_status
6758
6759 =item status
6760
6761 Returns a status string for this customer, currently:
6762
6763 =over 4
6764
6765 =item prospect - No packages have ever been ordered
6766
6767 =item active - One or more recurring packages is active
6768
6769 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
6770
6771 =item suspended - All non-cancelled recurring packages are suspended
6772
6773 =item cancelled - All recurring packages are cancelled
6774
6775 =back
6776
6777 =cut
6778
6779 sub status { shift->cust_status(@_); }
6780
6781 sub cust_status {
6782   my $self = shift;
6783   for my $status (qw( prospect active inactive suspended cancelled )) {
6784     my $method = $status.'_sql';
6785     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
6786     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
6787     $sth->execute( ($self->custnum) x $numnum )
6788       or die "Error executing 'SELECT $sql': ". $sth->errstr;
6789     return $status if $sth->fetchrow_arrayref->[0];
6790   }
6791 }
6792
6793 =item ucfirst_cust_status
6794
6795 =item ucfirst_status
6796
6797 Returns the status with the first character capitalized.
6798
6799 =cut
6800
6801 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
6802
6803 sub ucfirst_cust_status {
6804   my $self = shift;
6805   ucfirst($self->cust_status);
6806 }
6807
6808 =item statuscolor
6809
6810 Returns a hex triplet color string for this customer's status.
6811
6812 =cut
6813
6814 use vars qw(%statuscolor);
6815 tie %statuscolor, 'Tie::IxHash',
6816   'prospect'  => '7e0079', #'000000', #black?  naw, purple
6817   'active'    => '00CC00', #green
6818   'inactive'  => '0000CC', #blue
6819   'suspended' => 'FF9900', #yellow
6820   'cancelled' => 'FF0000', #red
6821 ;
6822
6823 sub statuscolor { shift->cust_statuscolor(@_); }
6824
6825 sub cust_statuscolor {
6826   my $self = shift;
6827   $statuscolor{$self->cust_status};
6828 }
6829
6830 =item tickets
6831
6832 Returns an array of hashes representing the customer's RT tickets.
6833
6834 =cut
6835
6836 sub tickets {
6837   my $self = shift;
6838
6839   my $num = $conf->config('cust_main-max_tickets') || 10;
6840   my @tickets = ();
6841
6842   if ( $conf->config('ticket_system') ) {
6843     unless ( $conf->config('ticket_system-custom_priority_field') ) {
6844
6845       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
6846
6847     } else {
6848
6849       foreach my $priority (
6850         $conf->config('ticket_system-custom_priority_field-values'), ''
6851       ) {
6852         last if scalar(@tickets) >= $num;
6853         push @tickets,
6854           @{ FS::TicketSystem->customer_tickets( $self->custnum,
6855                                                  $num - scalar(@tickets),
6856                                                  $priority,
6857                                                )
6858            };
6859       }
6860     }
6861   }
6862   (@tickets);
6863 }
6864
6865 # Return services representing svc_accts in customer support packages
6866 sub support_services {
6867   my $self = shift;
6868   my %packages = map { $_ => 1 } $conf->config('support_packages');
6869
6870   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
6871     grep { $_->part_svc->svcdb eq 'svc_acct' }
6872     map { $_->cust_svc }
6873     grep { exists $packages{ $_->pkgpart } }
6874     $self->ncancelled_pkgs;
6875
6876 }
6877
6878 =back
6879
6880 =head1 CLASS METHODS
6881
6882 =over 4
6883
6884 =item statuses
6885
6886 Class method that returns the list of possible status strings for customers
6887 (see L<the status method|/status>).  For example:
6888
6889   @statuses = FS::cust_main->statuses();
6890
6891 =cut
6892
6893 sub statuses {
6894   #my $self = shift; #could be class...
6895   keys %statuscolor;
6896 }
6897
6898 =item prospect_sql
6899
6900 Returns an SQL expression identifying prospective cust_main records (customers
6901 with no packages ever ordered)
6902
6903 =cut
6904
6905 use vars qw($select_count_pkgs);
6906 $select_count_pkgs =
6907   "SELECT COUNT(*) FROM cust_pkg
6908     WHERE cust_pkg.custnum = cust_main.custnum";
6909
6910 sub select_count_pkgs_sql {
6911   $select_count_pkgs;
6912 }
6913
6914 sub prospect_sql { "
6915   0 = ( $select_count_pkgs )
6916 "; }
6917
6918 =item active_sql
6919
6920 Returns an SQL expression identifying active cust_main records (customers with
6921 active recurring packages).
6922
6923 =cut
6924
6925 sub active_sql { "
6926   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
6927       )
6928 "; }
6929
6930 =item inactive_sql
6931
6932 Returns an SQL expression identifying inactive cust_main records (customers with
6933 no active recurring packages, but otherwise unsuspended/uncancelled).
6934
6935 =cut
6936
6937 sub inactive_sql { "
6938   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
6939   AND
6940   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
6941 "; }
6942
6943 =item susp_sql
6944 =item suspended_sql
6945
6946 Returns an SQL expression identifying suspended cust_main records.
6947
6948 =cut
6949
6950
6951 sub suspended_sql { susp_sql(@_); }
6952 sub susp_sql { "
6953     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
6954     AND
6955     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
6956 "; }
6957
6958 =item cancel_sql
6959 =item cancelled_sql
6960
6961 Returns an SQL expression identifying cancelled cust_main records.
6962
6963 =cut
6964
6965 sub cancelled_sql { cancel_sql(@_); }
6966 sub cancel_sql {
6967
6968   my $recurring_sql = FS::cust_pkg->recurring_sql;
6969   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
6970
6971   "
6972         0 < ( $select_count_pkgs )
6973     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
6974     AND 0 = ( $select_count_pkgs AND $recurring_sql
6975                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
6976             )
6977     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
6978   ";
6979
6980 }
6981
6982 =item uncancel_sql
6983 =item uncancelled_sql
6984
6985 Returns an SQL expression identifying un-cancelled cust_main records.
6986
6987 =cut
6988
6989 sub uncancelled_sql { uncancel_sql(@_); }
6990 sub uncancel_sql { "
6991   ( 0 < ( $select_count_pkgs
6992                    AND ( cust_pkg.cancel IS NULL
6993                          OR cust_pkg.cancel = 0
6994                        )
6995         )
6996     OR 0 = ( $select_count_pkgs )
6997   )
6998 "; }
6999
7000 =item balance_sql
7001
7002 Returns an SQL fragment to retreive the balance.
7003
7004 =cut
7005
7006 sub balance_sql { "
7007     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7008         WHERE cust_bill.custnum   = cust_main.custnum     )
7009   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
7010         WHERE cust_pay.custnum    = cust_main.custnum     )
7011   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
7012         WHERE cust_credit.custnum = cust_main.custnum     )
7013   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
7014         WHERE cust_refund.custnum = cust_main.custnum     )
7015 "; }
7016
7017 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7018
7019 Returns an SQL fragment to retreive the balance for this customer, only
7020 considering invoices with date earlier than START_TIME, and optionally not
7021 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7022 total_unapplied_payments).
7023
7024 Times are specified as SQL fragments or numeric
7025 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
7026 L<Date::Parse> for conversion functions.  The empty string can be passed
7027 to disable that time constraint completely.
7028
7029 Available options are:
7030
7031 =over 4
7032
7033 =item unapplied_date
7034
7035 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)
7036
7037 =item total
7038
7039 (unused.  obsolete?)
7040 set to true to remove all customer comparison clauses, for totals
7041
7042 =item where
7043
7044 (unused.  obsolete?)
7045 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7046
7047 =item join
7048
7049 (unused.  obsolete?)
7050 JOIN clause (typically used with the total option)
7051
7052 =back
7053
7054 =cut
7055
7056 sub balance_date_sql {
7057   my( $class, $start, $end, %opt ) = @_;
7058
7059   my $owed         = FS::cust_bill->owed_sql;
7060   my $unapp_refund = FS::cust_refund->unapplied_sql;
7061   my $unapp_credit = FS::cust_credit->unapplied_sql;
7062   my $unapp_pay    = FS::cust_pay->unapplied_sql;
7063
7064   my $j = $opt{'join'} || '';
7065
7066   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
7067   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7068   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7069   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
7070
7071   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
7072     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7073     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7074     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
7075   ";
7076
7077 }
7078
7079 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7080
7081 Helper method for balance_date_sql; name (and usage) subject to change
7082 (suggestions welcome).
7083
7084 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7085 cust_refund, cust_credit or cust_pay).
7086
7087 If TABLE is "cust_bill" or the unapplied_date option is true, only
7088 considers records with date earlier than START_TIME, and optionally not
7089 later than END_TIME .
7090
7091 =cut
7092
7093 sub _money_table_where {
7094   my( $class, $table, $start, $end, %opt ) = @_;
7095
7096   my @where = ();
7097   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7098   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7099     push @where, "$table._date <= $start" if defined($start) && length($start);
7100     push @where, "$table._date >  $end"   if defined($end)   && length($end);
7101   }
7102   push @where, @{$opt{'where'}} if $opt{'where'};
7103   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7104
7105   $where;
7106
7107 }
7108
7109 =item search_sql HASHREF
7110
7111 (Class method)
7112
7113 Returns a qsearch hash expression to search for parameters specified in HREF.
7114 Valid parameters are
7115
7116 =over 4
7117
7118 =item agentnum
7119
7120 =item status
7121
7122 =item cancelled_pkgs
7123
7124 bool
7125
7126 =item signupdate
7127
7128 listref of start date, end date
7129
7130 =item payby
7131
7132 listref
7133
7134 =item current_balance
7135
7136 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7137
7138 =item cust_fields
7139
7140 =item flattened_pkgs
7141
7142 bool
7143
7144 =back
7145
7146 =cut
7147
7148 sub search_sql {
7149   my ($class, $params) = @_;
7150
7151   my $dbh = dbh;
7152
7153   my @where = ();
7154   my $orderby;
7155
7156   ##
7157   # parse agent
7158   ##
7159
7160   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7161     push @where,
7162       "cust_main.agentnum = $1";
7163   }
7164
7165   ##
7166   # parse status
7167   ##
7168
7169   #prospect active inactive suspended cancelled
7170   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7171     my $method = $params->{'status'}. '_sql';
7172     #push @where, $class->$method();
7173     push @where, FS::cust_main->$method();
7174   }
7175
7176   ##
7177   # parse cancelled package checkbox
7178   ##
7179
7180   my $pkgwhere = "";
7181
7182   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7183     unless $params->{'cancelled_pkgs'};
7184
7185   ##
7186   # dates
7187   ##
7188
7189   foreach my $field (qw( signupdate )) {
7190
7191     next unless exists($params->{$field});
7192
7193     my($beginning, $ending) = @{$params->{$field}};
7194
7195     push @where,
7196       "cust_main.$field IS NOT NULL",
7197       "cust_main.$field >= $beginning",
7198       "cust_main.$field <= $ending";
7199
7200     $orderby ||= "ORDER BY cust_main.$field";
7201
7202   }
7203
7204   ###
7205   # payby
7206   ###
7207
7208   my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
7209   if ( @payby ) {
7210     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
7211   }
7212
7213   ##
7214   # amounts
7215   ##
7216
7217   #my $balance_sql = $class->balance_sql();
7218   my $balance_sql = FS::cust_main->balance_sql();
7219
7220   push @where, map { s/current_balance/$balance_sql/; $_ }
7221                    @{ $params->{'current_balance'} };
7222
7223   ##
7224   # custbatch
7225   ##
7226
7227   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
7228     push @where,
7229       "cust_main.custbatch = '$1'";
7230   }
7231
7232   ##
7233   # setup queries, subs, etc. for the search
7234   ##
7235
7236   $orderby ||= 'ORDER BY custnum';
7237
7238   # here is the agent virtualization
7239   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
7240
7241   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
7242
7243   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
7244
7245   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
7246
7247   my $select = join(', ',
7248                  'cust_main.custnum',
7249                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
7250                );
7251
7252   my(@extra_headers) = ();
7253   my(@extra_fields)  = ();
7254
7255   if ($params->{'flattened_pkgs'}) {
7256
7257     if ($dbh->{Driver}->{Name} eq 'Pg') {
7258
7259       $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";
7260
7261     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
7262       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
7263       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
7264     }else{
7265       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
7266            "omitting packing information from report.";
7267     }
7268
7269     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";
7270
7271     my $sth = dbh->prepare($header_query) or die dbh->errstr;
7272     $sth->execute() or die $sth->errstr;
7273     my $headerrow = $sth->fetchrow_arrayref;
7274     my $headercount = $headerrow ? $headerrow->[0] : 0;
7275     while($headercount) {
7276       unshift @extra_headers, "Package ". $headercount;
7277       unshift @extra_fields, eval q!sub {my $c = shift;
7278                                          my @a = split '\|', $c->magic;
7279                                          my $p = $a[!.--$headercount. q!];
7280                                          $p;
7281                                         };!;
7282     }
7283
7284   }
7285
7286   my $sql_query = {
7287     'table'         => 'cust_main',
7288     'select'        => $select,
7289     'hashref'       => {},
7290     'extra_sql'     => $extra_sql,
7291     'order_by'      => $orderby,
7292     'count_query'   => $count_query,
7293     'extra_headers' => \@extra_headers,
7294     'extra_fields'  => \@extra_fields,
7295   };
7296
7297 }
7298
7299 =item email_search_sql HASHREF
7300
7301 (Class method)
7302
7303 Emails a notice to the specified customers.
7304
7305 Valid parameters are those of the L<search_sql> method, plus the following:
7306
7307 =over 4
7308
7309 =item from
7310
7311 From: address
7312
7313 =item subject
7314
7315 Email Subject:
7316
7317 =item html_body
7318
7319 HTML body
7320
7321 =item text_body
7322
7323 Text body
7324
7325 =item job
7326
7327 Optional job queue job for status updates.
7328
7329 =back
7330
7331 Returns an error message, or false for success.
7332
7333 If an error occurs during any email, stops the enture send and returns that
7334 error.  Presumably if you're getting SMTP errors aborting is better than
7335 retrying everything.
7336
7337 =cut
7338
7339 sub email_search_sql {
7340   my($class, $params) = @_;
7341
7342   my $from = delete $params->{from};
7343   my $subject = delete $params->{subject};
7344   my $html_body = delete $params->{html_body};
7345   my $text_body = delete $params->{text_body};
7346
7347   my $job = delete $params->{'job'};
7348
7349   my $sql_query = $class->search_sql($params);
7350
7351   my $count_query   = delete($sql_query->{'count_query'});
7352   my $count_sth = dbh->prepare($count_query)
7353     or die "Error preparing $count_query: ". dbh->errstr;
7354   $count_sth->execute
7355     or die "Error executing $count_query: ". $count_sth->errstr;
7356   my $count_arrayref = $count_sth->fetchrow_arrayref;
7357   my $num_cust = $count_arrayref->[0];
7358
7359   #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
7360   #my @extra_fields  = @{ delete($sql_query->{'extra_fields'})  };
7361
7362
7363   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
7364
7365   #eventually order+limit magic to reduce memory use?
7366   foreach my $cust_main ( qsearch($sql_query) ) {
7367
7368     my $to = $cust_main->invoicing_list_emailonly_scalar;
7369     next unless $to;
7370
7371     my $error = send_email(
7372       generate_email(
7373         'from'      => $from,
7374         'to'        => $to,
7375         'subject'   => $subject,
7376         'html_body' => $html_body,
7377         'text_body' => $text_body,
7378       )
7379     );
7380     return $error if $error;
7381
7382     if ( $job ) { #progressbar foo
7383       $num++;
7384       if ( time - $min_sec > $last ) {
7385         my $error = $job->update_statustext(
7386           int( 100 * $num / $num_cust )
7387         );
7388         die $error if $error;
7389         $last = time;
7390       }
7391     }
7392
7393   }
7394
7395   return '';
7396 }
7397
7398 use Storable qw(thaw);
7399 use Data::Dumper;
7400 use MIME::Base64;
7401 sub process_email_search_sql {
7402   my $job = shift;
7403   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
7404
7405   my $param = thaw(decode_base64(shift));
7406   warn Dumper($param) if $DEBUG;
7407
7408   $param->{'job'} = $job;
7409
7410   my $error = FS::cust_main->email_search_sql( $param );
7411   die $error if $error;
7412
7413 }
7414
7415 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
7416
7417 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
7418 records.  Currently, I<first>, I<last> and/or I<company> may be specified (the
7419 appropriate ship_ field is also searched).
7420
7421 Additional options are the same as FS::Record::qsearch
7422
7423 =cut
7424
7425 sub fuzzy_search {
7426   my( $self, $fuzzy, $hash, @opt) = @_;
7427   #$self
7428   $hash ||= {};
7429   my @cust_main = ();
7430
7431   check_and_rebuild_fuzzyfiles();
7432   foreach my $field ( keys %$fuzzy ) {
7433
7434     my $all = $self->all_X($field);
7435     next unless scalar(@$all);
7436
7437     my %match = ();
7438     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
7439
7440     my @fcust = ();
7441     foreach ( keys %match ) {
7442       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
7443       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
7444     }
7445     my %fsaw = ();
7446     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
7447   }
7448
7449   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
7450   my %saw = ();
7451   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
7452
7453   @cust_main;
7454
7455 }
7456
7457 =item masked FIELD
7458
7459 Returns a masked version of the named field
7460
7461 =cut
7462
7463 sub masked {
7464 my ($self,$field) = @_;
7465
7466 # Show last four
7467
7468 'x'x(length($self->getfield($field))-4).
7469   substr($self->getfield($field), (length($self->getfield($field))-4));
7470
7471 }
7472
7473 =back
7474
7475 =head1 SUBROUTINES
7476
7477 =over 4
7478
7479 =item smart_search OPTION => VALUE ...
7480
7481 Accepts the following options: I<search>, the string to search for.  The string
7482 will be searched for as a customer number, phone number, name or company name,
7483 as an exact, or, in some cases, a substring or fuzzy match (see the source code
7484 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
7485 skip fuzzy matching when an exact match is found.
7486
7487 Any additional options are treated as an additional qualifier on the search
7488 (i.e. I<agentnum>).
7489
7490 Returns a (possibly empty) array of FS::cust_main objects.
7491
7492 =cut
7493
7494 sub smart_search {
7495   my %options = @_;
7496
7497   #here is the agent virtualization
7498   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
7499
7500   my @cust_main = ();
7501
7502   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
7503   my $search = delete $options{'search'};
7504   ( my $alphanum_search = $search ) =~ s/\W//g;
7505
7506   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
7507
7508     #false laziness w/Record::ut_phone
7509     my $phonen = "$1-$2-$3";
7510     $phonen .= " x$4" if $4;
7511
7512     push @cust_main, qsearch( {
7513       'table'   => 'cust_main',
7514       'hashref' => { %options },
7515       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7516                      ' ( '.
7517                          join(' OR ', map "$_ = '$phonen'",
7518                                           qw( daytime night fax
7519                                               ship_daytime ship_night ship_fax )
7520                              ).
7521                      ' ) '.
7522                      " AND $agentnums_sql", #agent virtualization
7523     } );
7524
7525     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
7526       #try looking for matches with extensions unless one was specified
7527
7528       push @cust_main, qsearch( {
7529         'table'   => 'cust_main',
7530         'hashref' => { %options },
7531         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
7532                        ' ( '.
7533                            join(' OR ', map "$_ LIKE '$phonen\%'",
7534                                             qw( daytime night
7535                                                 ship_daytime ship_night )
7536                                ).
7537                        ' ) '.
7538                        " AND $agentnums_sql", #agent virtualization
7539       } );
7540
7541     }
7542
7543   # custnum search (also try agent_custid), with some tweaking options if your
7544   # legacy cust "numbers" have letters
7545   }
7546
7547   if ( $search =~ /^\s*(\d+)\s*$/
7548             || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
7549                  && $search =~ /^\s*(\w\w?\d+)\s*$/
7550                )
7551           )
7552   {
7553
7554     my $num = $1;
7555
7556     if ( $num <= 2147483647 ) { #need a bigint custnum?  wow.
7557       push @cust_main, qsearch( {
7558         'table'     => 'cust_main',
7559         'hashref'   => { 'custnum' => $num, %options },
7560         'extra_sql' => " AND $agentnums_sql", #agent virtualization
7561       } );
7562     }
7563
7564     push @cust_main, qsearch( {
7565       'table'     => 'cust_main',
7566       'hashref'   => { 'agent_custid' => $num, %options },
7567       'extra_sql' => " AND $agentnums_sql", #agent virtualization
7568     } );
7569
7570   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
7571
7572     my($company, $last, $first) = ( $1, $2, $3 );
7573
7574     # "Company (Last, First)"
7575     #this is probably something a browser remembered,
7576     #so just do an exact search
7577
7578     foreach my $prefix ( '', 'ship_' ) {
7579       push @cust_main, qsearch( {
7580         'table'     => 'cust_main',
7581         'hashref'   => { $prefix.'first'   => $first,
7582                          $prefix.'last'    => $last,
7583                          $prefix.'company' => $company,
7584                          %options,
7585                        },
7586         'extra_sql' => " AND $agentnums_sql",
7587       } );
7588     }
7589
7590   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
7591                                               # try (ship_){last,company}
7592
7593     my $value = lc($1);
7594
7595     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
7596     # # full strings the browser remembers won't work
7597     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
7598
7599     use Lingua::EN::NameParse;
7600     my $NameParse = new Lingua::EN::NameParse(
7601              auto_clean     => 1,
7602              allow_reversed => 1,
7603     );
7604
7605     my($last, $first) = ( '', '' );
7606     #maybe disable this too and just rely on NameParse?
7607     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
7608
7609       ($last, $first) = ( $1, $2 );
7610
7611     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
7612     } elsif ( ! $NameParse->parse($value) ) {
7613
7614       my %name = $NameParse->components;
7615       $first = $name{'given_name_1'};
7616       $last  = $name{'surname_1'};
7617
7618     }
7619
7620     if ( $first && $last ) {
7621
7622       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
7623
7624       #exact
7625       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
7626       $sql .= "
7627         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
7628            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
7629         )";
7630
7631       push @cust_main, qsearch( {
7632         'table'     => 'cust_main',
7633         'hashref'   => \%options,
7634         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
7635       } );
7636
7637       # or it just be something that was typed in... (try that in a sec)
7638
7639     }
7640
7641     my $q_value = dbh->quote($value);
7642
7643     #exact
7644     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
7645     $sql .= " (    LOWER(last)         = $q_value
7646                 OR LOWER(company)      = $q_value
7647                 OR LOWER(ship_last)    = $q_value
7648                 OR LOWER(ship_company) = $q_value
7649               )";
7650
7651     push @cust_main, qsearch( {
7652       'table'     => 'cust_main',
7653       'hashref'   => \%options,
7654       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
7655     } );
7656
7657     #no exact match, trying substring/fuzzy
7658     #always do substring & fuzzy (unless they're explicity config'ed off)
7659     #getting complaints searches are not returning enough
7660     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
7661
7662       #still some false laziness w/search_sql (was search/cust_main.cgi)
7663
7664       #substring
7665
7666       my @hashrefs = (
7667         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
7668         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
7669       );
7670
7671       if ( $first && $last ) {
7672
7673         push @hashrefs,
7674           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
7675             'last'         => { op=>'ILIKE', value=>"%$last%" },
7676           },
7677           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
7678             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
7679           },
7680         ;
7681
7682       } else {
7683
7684         push @hashrefs,
7685           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
7686           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
7687         ;
7688       }
7689
7690       foreach my $hashref ( @hashrefs ) {
7691
7692         push @cust_main, qsearch( {
7693           'table'     => 'cust_main',
7694           'hashref'   => { %$hashref,
7695                            %options,
7696                          },
7697           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
7698         } );
7699
7700       }
7701
7702       #fuzzy
7703       my @fuzopts = (
7704         \%options,                #hashref
7705         '',                       #select
7706         " AND $agentnums_sql",    #extra_sql  #agent virtualization
7707       );
7708
7709       if ( $first && $last ) {
7710         push @cust_main, FS::cust_main->fuzzy_search(
7711           { 'last'   => $last,    #fuzzy hashref
7712             'first'  => $first }, #
7713           @fuzopts
7714         );
7715       }
7716       foreach my $field ( 'last', 'company' ) {
7717         push @cust_main,
7718           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
7719       }
7720
7721     }
7722
7723     #eliminate duplicates
7724     my %saw = ();
7725     @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
7726
7727   }
7728
7729   @cust_main;
7730
7731 }
7732
7733 =item email_search
7734
7735 Accepts the following options: I<email>, the email address to search for.  The
7736 email address will be searched for as an email invoice destination and as an
7737 svc_acct account.
7738
7739 #Any additional options are treated as an additional qualifier on the search
7740 #(i.e. I<agentnum>).
7741
7742 Returns a (possibly empty) array of FS::cust_main objects (but usually just
7743 none or one).
7744
7745 =cut
7746
7747 sub email_search {
7748   my %options = @_;
7749
7750   local($DEBUG) = 1;
7751
7752   my $email = delete $options{'email'};
7753
7754   #we're only being used by RT at the moment... no agent virtualization yet
7755   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
7756
7757   my @cust_main = ();
7758
7759   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
7760
7761     my ( $user, $domain ) = ( $1, $2 );
7762
7763     warn "$me smart_search: searching for $user in domain $domain"
7764       if $DEBUG;
7765
7766     push @cust_main,
7767       map $_->cust_main,
7768           qsearch( {
7769                      'table'     => 'cust_main_invoice',
7770                      'hashref'   => { 'dest' => $email },
7771                    }
7772                  );
7773
7774     push @cust_main,
7775       map  $_->cust_main,
7776       grep $_,
7777       map  $_->cust_svc->cust_pkg,
7778           qsearch( {
7779                      'table'     => 'svc_acct',
7780                      'hashref'   => { 'username' => $user, },
7781                      'extra_sql' =>
7782                        'AND ( SELECT domain FROM svc_domain
7783                                 WHERE svc_acct.domsvc = svc_domain.svcnum
7784                             ) = '. dbh->quote($domain),
7785                    }
7786                  );
7787   }
7788
7789   my %saw = ();
7790   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
7791
7792   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
7793     if $DEBUG;
7794
7795   @cust_main;
7796
7797 }
7798
7799 =item check_and_rebuild_fuzzyfiles
7800
7801 =cut
7802
7803 use vars qw(@fuzzyfields);
7804 @fuzzyfields = ( 'last', 'first', 'company' );
7805
7806 sub check_and_rebuild_fuzzyfiles {
7807   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
7808   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
7809 }
7810
7811 =item rebuild_fuzzyfiles
7812
7813 =cut
7814
7815 sub rebuild_fuzzyfiles {
7816
7817   use Fcntl qw(:flock);
7818
7819   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
7820   mkdir $dir, 0700 unless -d $dir;
7821
7822   foreach my $fuzzy ( @fuzzyfields ) {
7823
7824     open(LOCK,">>$dir/cust_main.$fuzzy")
7825       or die "can't open $dir/cust_main.$fuzzy: $!";
7826     flock(LOCK,LOCK_EX)
7827       or die "can't lock $dir/cust_main.$fuzzy: $!";
7828
7829     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
7830       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
7831
7832     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
7833       my $sth = dbh->prepare("SELECT $field FROM cust_main".
7834                              " WHERE $field != '' AND $field IS NOT NULL");
7835       $sth->execute or die $sth->errstr;
7836
7837       while ( my $row = $sth->fetchrow_arrayref ) {
7838         print CACHE $row->[0]. "\n";
7839       }
7840
7841     }
7842
7843     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
7844
7845     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
7846     close LOCK;
7847   }
7848
7849 }
7850
7851 =item all_X
7852
7853 =cut
7854
7855 sub all_X {
7856   my( $self, $field ) = @_;
7857   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
7858   open(CACHE,"<$dir/cust_main.$field")
7859     or die "can't open $dir/cust_main.$field: $!";
7860   my @array = map { chomp; $_; } <CACHE>;
7861   close CACHE;
7862   \@array;
7863 }
7864
7865 =item append_fuzzyfiles LASTNAME COMPANY
7866
7867 =cut
7868
7869 sub append_fuzzyfiles {
7870   #my( $first, $last, $company ) = @_;
7871
7872   &check_and_rebuild_fuzzyfiles;
7873
7874   use Fcntl qw(:flock);
7875
7876   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
7877
7878   foreach my $field (qw( first last company )) {
7879     my $value = shift;
7880
7881     if ( $value ) {
7882
7883       open(CACHE,">>$dir/cust_main.$field")
7884         or die "can't open $dir/cust_main.$field: $!";
7885       flock(CACHE,LOCK_EX)
7886         or die "can't lock $dir/cust_main.$field: $!";
7887
7888       print CACHE "$value\n";
7889
7890       flock(CACHE,LOCK_UN)
7891         or die "can't unlock $dir/cust_main.$field: $!";
7892       close CACHE;
7893     }
7894
7895   }
7896
7897   1;
7898 }
7899
7900 =item batch_charge
7901
7902 =cut
7903
7904 sub batch_charge {
7905   my $param = shift;
7906   #warn join('-',keys %$param);
7907   my $fh = $param->{filehandle};
7908   my @fields = @{$param->{fields}};
7909
7910   eval "use Text::CSV_XS;";
7911   die $@ if $@;
7912
7913   my $csv = new Text::CSV_XS;
7914   #warn $csv;
7915   #warn $fh;
7916
7917   my $imported = 0;
7918   #my $columns;
7919
7920   local $SIG{HUP} = 'IGNORE';
7921   local $SIG{INT} = 'IGNORE';
7922   local $SIG{QUIT} = 'IGNORE';
7923   local $SIG{TERM} = 'IGNORE';
7924   local $SIG{TSTP} = 'IGNORE';
7925   local $SIG{PIPE} = 'IGNORE';
7926
7927   my $oldAutoCommit = $FS::UID::AutoCommit;
7928   local $FS::UID::AutoCommit = 0;
7929   my $dbh = dbh;
7930
7931   #while ( $columns = $csv->getline($fh) ) {
7932   my $line;
7933   while ( defined($line=<$fh>) ) {
7934
7935     $csv->parse($line) or do {
7936       $dbh->rollback if $oldAutoCommit;
7937       return "can't parse: ". $csv->error_input();
7938     };
7939
7940     my @columns = $csv->fields();
7941     #warn join('-',@columns);
7942
7943     my %row = ();
7944     foreach my $field ( @fields ) {
7945       $row{$field} = shift @columns;
7946     }
7947
7948     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
7949     unless ( $cust_main ) {
7950       $dbh->rollback if $oldAutoCommit;
7951       return "unknown custnum $row{'custnum'}";
7952     }
7953
7954     if ( $row{'amount'} > 0 ) {
7955       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
7956       if ( $error ) {
7957         $dbh->rollback if $oldAutoCommit;
7958         return $error;
7959       }
7960       $imported++;
7961     } elsif ( $row{'amount'} < 0 ) {
7962       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
7963                                       $row{'pkg'}                         );
7964       if ( $error ) {
7965         $dbh->rollback if $oldAutoCommit;
7966         return $error;
7967       }
7968       $imported++;
7969     } else {
7970       #hmm?
7971     }
7972
7973   }
7974
7975   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
7976
7977   return "Empty file!" unless $imported;
7978
7979   ''; #no error
7980
7981 }
7982
7983 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
7984
7985 Sends a templated email notification to the customer (see L<Text::Template>).
7986
7987 OPTIONS is a hash and may include
7988
7989 I<from> - the email sender (default is invoice_from)
7990
7991 I<to> - comma-separated scalar or arrayref of recipients
7992    (default is invoicing_list)
7993
7994 I<subject> - The subject line of the sent email notification
7995    (default is "Notice from company_name")
7996
7997 I<extra_fields> - a hashref of name/value pairs which will be substituted
7998    into the template
7999
8000 The following variables are vavailable in the template.
8001
8002 I<$first> - the customer first name
8003 I<$last> - the customer last name
8004 I<$company> - the customer company
8005 I<$payby> - a description of the method of payment for the customer
8006             # would be nice to use FS::payby::shortname
8007 I<$payinfo> - the account information used to collect for this customer
8008 I<$expdate> - the expiration of the customer payment in seconds from epoch
8009
8010 =cut
8011
8012 sub notify {
8013   my ($self, $template, %options) = @_;
8014
8015   return unless $conf->exists($template);
8016
8017   my $from = $conf->config('invoice_from', $self->agentnum)
8018     if $conf->exists('invoice_from', $self->agentnum);
8019   $from = $options{from} if exists($options{from});
8020
8021   my $to = join(',', $self->invoicing_list_emailonly);
8022   $to = $options{to} if exists($options{to});
8023
8024   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8025     if $conf->exists('company_name', $self->agentnum);
8026   $subject = $options{subject} if exists($options{subject});
8027
8028   my $notify_template = new Text::Template (TYPE => 'ARRAY',
8029                                             SOURCE => [ map "$_\n",
8030                                               $conf->config($template)]
8031                                            )
8032     or die "can't create new Text::Template object: Text::Template::ERROR";
8033   $notify_template->compile()
8034     or die "can't compile template: Text::Template::ERROR";
8035
8036   $FS::notify_template::_template::company_name =
8037     $conf->config('company_name', $self->agentnum);
8038   $FS::notify_template::_template::company_address =
8039     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
8040
8041   my $paydate = $self->paydate || '2037-12-31';
8042   $FS::notify_template::_template::first = $self->first;
8043   $FS::notify_template::_template::last = $self->last;
8044   $FS::notify_template::_template::company = $self->company;
8045   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
8046   my $payby = $self->payby;
8047   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8048   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8049
8050   #credit cards expire at the end of the month/year of their exp date
8051   if ($payby eq 'CARD' || $payby eq 'DCRD') {
8052     $FS::notify_template::_template::payby = 'credit card';
8053     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8054     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8055     $expire_time--;
8056   }elsif ($payby eq 'COMP') {
8057     $FS::notify_template::_template::payby = 'complimentary account';
8058   }else{
8059     $FS::notify_template::_template::payby = 'current method';
8060   }
8061   $FS::notify_template::_template::expdate = $expire_time;
8062
8063   for (keys %{$options{extra_fields}}){
8064     no strict "refs";
8065     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
8066   }
8067
8068   send_email(from => $from,
8069              to => $to,
8070              subject => $subject,
8071              body => $notify_template->fill_in( PACKAGE =>
8072                                                 'FS::notify_template::_template'                                              ),
8073             );
8074
8075 }
8076
8077 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8078
8079 Generates a templated notification to the customer (see L<Text::Template>).
8080
8081 OPTIONS is a hash and may include
8082
8083 I<extra_fields> - a hashref of name/value pairs which will be substituted
8084    into the template.  These values may override values mentioned below
8085    and those from the customer record.
8086
8087 The following variables are available in the template instead of or in addition
8088 to the fields of the customer record.
8089
8090 I<$payby> - a description of the method of payment for the customer
8091             # would be nice to use FS::payby::shortname
8092 I<$payinfo> - the masked account information used to collect for this customer
8093 I<$expdate> - the expiration of the customer payment method in seconds from epoch
8094 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
8095
8096 =cut
8097
8098 sub generate_letter {
8099   my ($self, $template, %options) = @_;
8100
8101   return unless $conf->exists($template);
8102
8103   my $letter_template = new Text::Template
8104                         ( TYPE       => 'ARRAY',
8105                           SOURCE     => [ map "$_\n", $conf->config($template)],
8106                           DELIMITERS => [ '[@--', '--@]' ],
8107                         )
8108     or die "can't create new Text::Template object: Text::Template::ERROR";
8109
8110   $letter_template->compile()
8111     or die "can't compile template: Text::Template::ERROR";
8112
8113   my %letter_data = map { $_ => $self->$_ } $self->fields;
8114   $letter_data{payinfo} = $self->mask_payinfo;
8115
8116   #my $paydate = $self->paydate || '2037-12-31';
8117   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
8118
8119   my $payby = $self->payby;
8120   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
8121   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
8122
8123   #credit cards expire at the end of the month/year of their exp date
8124   if ($payby eq 'CARD' || $payby eq 'DCRD') {
8125     $letter_data{payby} = 'credit card';
8126     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
8127     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
8128     $expire_time--;
8129   }elsif ($payby eq 'COMP') {
8130     $letter_data{payby} = 'complimentary account';
8131   }else{
8132     $letter_data{payby} = 'current method';
8133   }
8134   $letter_data{expdate} = $expire_time;
8135
8136   for (keys %{$options{extra_fields}}){
8137     $letter_data{$_} = $options{extra_fields}->{$_};
8138   }
8139
8140   unless(exists($letter_data{returnaddress})){
8141     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
8142                                                   $self->agent_template)
8143                      );
8144     if ( length($retadd) ) {
8145       $letter_data{returnaddress} = $retadd;
8146     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
8147       $letter_data{returnaddress} =
8148         join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
8149                           $conf->config('company_address', $self->agentnum)
8150         );
8151     } else {
8152       $letter_data{returnaddress} = '~';
8153     }
8154   }
8155
8156   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
8157
8158   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
8159
8160   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
8161   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
8162                            DIR      => $dir,
8163                            SUFFIX   => '.tex',
8164                            UNLINK   => 0,
8165                          ) or die "can't open temp file: $!\n";
8166
8167   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
8168   close $fh;
8169   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
8170   return $1;
8171 }
8172
8173 =item print_ps TEMPLATE
8174
8175 Returns an postscript letter filled in from TEMPLATE, as a scalar.
8176
8177 =cut
8178
8179 sub print_ps {
8180   my $self = shift;
8181   my $file = $self->generate_letter(@_);
8182   FS::Misc::generate_ps($file);
8183 }
8184
8185 =item print TEMPLATE
8186
8187 Prints the filled in template.
8188
8189 TEMPLATE is the name of a L<Text::Template> to fill in and print.
8190
8191 =cut
8192
8193 sub queueable_print {
8194   my %opt = @_;
8195
8196   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
8197     or die "invalid customer number: " . $opt{custvnum};
8198
8199   my $error = $self->print( $opt{template} );
8200   die $error if $error;
8201 }
8202
8203 sub print {
8204   my ($self, $template) = (shift, shift);
8205   do_print [ $self->print_ps($template) ];
8206 }
8207
8208 #these three subs should just go away once agent stuff is all config overrides
8209
8210 sub agent_template {
8211   my $self = shift;
8212   $self->_agent_plandata('agent_templatename');
8213 }
8214
8215 sub agent_invoice_from {
8216   my $self = shift;
8217   $self->_agent_plandata('agent_invoice_from');
8218 }
8219
8220 sub _agent_plandata {
8221   my( $self, $option ) = @_;
8222
8223   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
8224   #agent-specific Conf
8225
8226   use FS::part_event::Condition;
8227
8228   my $agentnum = $self->agentnum;
8229
8230   my $regexp = '';
8231   if ( driver_name =~ /^Pg/i ) {
8232     $regexp = '~';
8233   } elsif ( driver_name =~ /^mysql/i ) {
8234     $regexp = 'REGEXP';
8235   } else {
8236     die "don't know how to use regular expressions in ". driver_name. " databases";
8237   }
8238
8239   my $part_event_option =
8240     qsearchs({
8241       'select'    => 'part_event_option.*',
8242       'table'     => 'part_event_option',
8243       'addl_from' => q{
8244         LEFT JOIN part_event USING ( eventpart )
8245         LEFT JOIN part_event_option AS peo_agentnum
8246           ON ( part_event.eventpart = peo_agentnum.eventpart
8247                AND peo_agentnum.optionname = 'agentnum'
8248                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
8249              )
8250         LEFT JOIN part_event_condition
8251           ON ( part_event.eventpart = part_event_condition.eventpart
8252                AND part_event_condition.conditionname = 'cust_bill_age'
8253              )
8254         LEFT JOIN part_event_condition_option
8255           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
8256                AND part_event_condition_option.optionname = 'age'
8257              )
8258       },
8259       #'hashref'   => { 'optionname' => $option },
8260       #'hashref'   => { 'part_event_option.optionname' => $option },
8261       'extra_sql' =>
8262         " WHERE part_event_option.optionname = ". dbh->quote($option).
8263         " AND action = 'cust_bill_send_agent' ".
8264         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
8265         " AND peo_agentnum.optionname = 'agentnum' ".
8266         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
8267         " ORDER BY
8268            CASE WHEN part_event_condition_option.optionname IS NULL
8269            THEN -1
8270            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
8271         " END
8272           , part_event.weight".
8273         " LIMIT 1"
8274     });
8275
8276   unless ( $part_event_option ) {
8277     return $self->agent->invoice_template || ''
8278       if $option eq 'agent_templatename';
8279     return '';
8280   }
8281
8282   $part_event_option->optionvalue;
8283
8284 }
8285
8286 sub queued_bill {
8287   ## actual sub, not a method, designed to be called from the queue.
8288   ## sets up the customer, and calls the bill_and_collect
8289   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
8290   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
8291       $cust_main->bill_and_collect(
8292         %args,
8293       );
8294 }
8295
8296 =back
8297
8298 =head1 BUGS
8299
8300 The delete method.
8301
8302 The delete method should possibly take an FS::cust_main object reference
8303 instead of a scalar customer number.
8304
8305 Bill and collect options should probably be passed as references instead of a
8306 list.
8307
8308 There should probably be a configuration file with a list of allowed credit
8309 card types.
8310
8311 No multiple currency support (probably a larger project than just this module).
8312
8313 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
8314
8315 Birthdates rely on negative epoch values.
8316
8317 The payby for card/check batches is broken.  With mixed batching, bad
8318 things will happen.
8319
8320 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
8321
8322 =head1 SEE ALSO
8323
8324 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
8325 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
8326 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
8327
8328 =cut
8329
8330 1;
8331