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