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     foreach my $part_pkg ( $postal_pkg->part_pkg->self_and_bill_linked ) {
2152       my $error =
2153         $self->_make_lines( 'part_pkg'            => $part_pkg,
2154                             'cust_pkg'            => $postal_pkg,
2155                             'precommit_hooks'     => \@precommit_hooks,
2156                             'line_items'          => \@cust_bill_pkg,
2157                             'setup'               => \$total_setup,
2158                             'recur'               => \$total_recur,
2159                             'tax_matrix'          => \%taxlisthash,
2160                             'time'                => $time,
2161                             'options'             => \%options,
2162                           );
2163       if ($error) {
2164         $dbh->rollback if $oldAutoCommit;
2165         return $error;
2166       }
2167     }
2168   }
2169
2170   warn "having a look at the taxes we found...\n" if $DEBUG > 2;
2171   foreach my $tax ( keys %taxlisthash ) {
2172     my $tax_object = shift @{ $taxlisthash{$tax} };
2173     warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
2174     my $listref_or_error = $tax_object->taxline( @{ $taxlisthash{$tax} } );
2175     unless (ref($listref_or_error)) {
2176       $dbh->rollback if $oldAutoCommit;
2177       return $listref_or_error;
2178     }
2179     unshift @{ $taxlisthash{$tax} }, $tax_object;
2180
2181     warn "adding ". $listref_or_error->[1].
2182          " as ". $listref_or_error->[0]. "\n"
2183       if $DEBUG > 2;
2184     $tax{ $tax_object->taxname } += $listref_or_error->[1];
2185     if ( $taxname{ $listref_or_error->[0] } ) {
2186       push @{ $taxname{ $listref_or_error->[0] } }, $tax_object->taxname;
2187     }else{
2188       $taxname{ $listref_or_error->[0] } = [ $tax_object->taxname ];
2189     }
2190
2191   }
2192
2193   #some taxes are taxed
2194   my %totlisthash;
2195
2196   warn "finding taxed taxes...\n" if $DEBUG > 2;
2197   foreach my $tax ( keys %taxlisthash ) {
2198     my $tax_object = shift @{ $taxlisthash{$tax} };
2199     warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
2200       if $DEBUG > 2;
2201     next unless $tax_object->can('tax_on_tax');
2202
2203     foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
2204       my $totname = ref( $tot ). ' '. $tot->taxnum;
2205
2206       warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
2207         if $DEBUG > 2;
2208       next unless exists( $taxlisthash{ $totname } ); # only increase
2209                                                       # existing taxes
2210       warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
2211       if ( exists( $totlisthash{ $totname } ) ) {
2212         push @{ $totlisthash{ $totname  } }, $tax{ $tax_object->taxname };
2213       }else{
2214         $totlisthash{ $totname } = [ $tot, $tax{ $tax_object->taxname } ];
2215       }
2216     }
2217   }
2218
2219   warn "having a look at taxed taxes...\n" if $DEBUG > 2;
2220   foreach my $tax ( keys %totlisthash ) {
2221     my $tax_object = shift @{ $totlisthash{$tax} };
2222     warn "found previously found taxed tax ". $tax_object->taxname. "\n"
2223       if $DEBUG > 2;
2224     my $listref_or_error = $tax_object->taxline( @{ $totlisthash{$tax} } );
2225     unless (ref($listref_or_error)) {
2226       $dbh->rollback if $oldAutoCommit;
2227       return $listref_or_error;
2228     }
2229
2230     warn "adding taxed tax amount ". $listref_or_error->[1].
2231          " as ". $tax_object->taxname. "\n"
2232       if $DEBUG;
2233     $tax{ $tax_object->taxname } += $listref_or_error->[1];
2234   }
2235
2236   #consolidate and create tax line items
2237   warn "consolidating and generating...\n" if $DEBUG > 2;
2238   foreach my $taxname ( keys %taxname ) {
2239     my $tax = 0;
2240     my %seen = ();
2241     warn "adding $taxname\n" if $DEBUG > 1;
2242     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
2243       $tax += $tax{$taxitem} unless $seen{$taxitem};
2244       warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
2245     }
2246     next unless $tax;
2247
2248     $tax = sprintf('%.2f', $tax );
2249     $total_setup = sprintf('%.2f', $total_setup+$tax );
2250
2251     push @cust_bill_pkg, new FS::cust_bill_pkg {
2252       'pkgnum'   => 0,
2253       'setup'    => $tax,
2254       'recur'    => 0,
2255       'sdate'    => '',
2256       'edate'    => '',
2257       'itemdesc' => $taxname,
2258     };
2259
2260   }
2261
2262   my $charged = sprintf('%.2f', $total_setup + $total_recur );
2263
2264   #create the new invoice
2265   my $cust_bill = new FS::cust_bill ( {
2266     'custnum' => $self->custnum,
2267     '_date'   => ( $options{'invoice_time'} || $time ),
2268     'charged' => $charged,
2269   } );
2270   my $error = $cust_bill->insert;
2271   if ( $error ) {
2272     $dbh->rollback if $oldAutoCommit;
2273     return "can't create invoice for customer #". $self->custnum. ": $error";
2274   }
2275
2276   foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
2277     $cust_bill_pkg->invnum($cust_bill->invnum);
2278     my $error = $cust_bill_pkg->insert;
2279     if ( $error ) {
2280       $dbh->rollback if $oldAutoCommit;
2281       return "can't create invoice line item: $error";
2282     }
2283   }
2284
2285
2286   foreach my $hook ( @precommit_hooks ) {
2287     eval {
2288       &{$hook}; #($self) ?
2289     };
2290     if ( $@ ) {
2291       $dbh->rollback if $oldAutoCommit;
2292       return "$@ running precommit hook $hook\n";
2293     }
2294   }
2295
2296   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2297   ''; #no error
2298 }
2299
2300
2301 sub _make_lines {
2302   my ($self, %params) = @_;
2303
2304   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
2305   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
2306   my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
2307   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
2308   my $total_setup = $params{setup} or die "no setup accumulator specified";
2309   my $total_recur = $params{recur} or die "no recur accumulator specified";
2310   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
2311   my $time = $params{'time'} or die "no time specified";
2312   my (%options) = %{$params{options}};  #hmmm  only for 'resetup'
2313
2314   my $dbh = dbh;
2315   my $real_pkgpart = $cust_pkg->pkgpart;
2316   my %hash = $cust_pkg->hash;
2317   my $old_cust_pkg = new FS::cust_pkg \%hash;
2318
2319   my @details = ();
2320
2321   my $lineitems = 0;
2322
2323   $cust_pkg->pkgpart($part_pkg->pkgpart);
2324
2325   ###
2326   # bill setup
2327   ###
2328
2329   my $setup = 0;
2330   my $unitsetup = 0;
2331   if ( ! $cust_pkg->setup &&
2332        (
2333          ( $conf->exists('disable_setup_suspended_pkgs') &&
2334           ! $cust_pkg->getfield('susp')
2335         ) || ! $conf->exists('disable_setup_suspended_pkgs')
2336        )
2337     || $options{'resetup'}
2338   ) {
2339
2340     warn "    bill setup\n" if $DEBUG > 1;
2341     $lineitems++;
2342
2343     $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
2344     return "$@ running calc_setup for $cust_pkg\n"
2345       if $@;
2346
2347     $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
2348
2349     $cust_pkg->setfield('setup', $time)
2350       unless $cust_pkg->setup;
2351           #do need it, but it won't get written to the db
2352           #|| $cust_pkg->pkgpart != $real_pkgpart;
2353
2354   }
2355
2356   ###
2357   # bill recurring fee
2358   ###
2359
2360   #XXX unit stuff here too
2361   my $recur = 0;
2362   my $unitrecur = 0;
2363   my $sdate;
2364   if ( $part_pkg->getfield('freq') ne '0' &&
2365        ! $cust_pkg->getfield('susp') &&
2366        ( $cust_pkg->getfield('bill') || 0 ) <= $time
2367   ) {
2368
2369     # XXX should this be a package event?  probably.  events are called
2370     # at collection time at the moment, though...
2371     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
2372       if $part_pkg->can('reset_usage');
2373       #don't want to reset usage just cause we want a line item??
2374       #&& $part_pkg->pkgpart == $real_pkgpart;
2375
2376     warn "    bill recur\n" if $DEBUG > 1;
2377     $lineitems++;
2378
2379     # XXX shared with $recur_prog
2380     $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2381
2382     #over two params!  lets at least switch to a hashref for the rest...
2383     my %param = ( 'precommit_hooks' => $precommit_hooks, );
2384
2385     $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) };
2386     return "$@ running calc_recur for $cust_pkg\n"
2387       if ( $@ );
2388
2389
2390     #change this bit to use Date::Manip? CAREFUL with timezones (see
2391     # mailing list archive)
2392     my ($sec,$min,$hour,$mday,$mon,$year) =
2393       (localtime($sdate) )[0,1,2,3,4,5];
2394
2395     #pro-rating magic - if $recur_prog fiddles $sdate, want to use that
2396     # only for figuring next bill date, nothing else, so, reset $sdate again
2397     # here
2398     $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
2399     #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
2400     $cust_pkg->last_bill($sdate);
2401
2402     if ( $part_pkg->freq =~ /^\d+$/ ) {
2403       $mon += $part_pkg->freq;
2404       until ( $mon < 12 ) { $mon -= 12; $year++; }
2405     } elsif ( $part_pkg->freq =~ /^(\d+)w$/ ) {
2406       my $weeks = $1;
2407       $mday += $weeks * 7;
2408     } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) {
2409       my $days = $1;
2410       $mday += $days;
2411     } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) {
2412       my $hours = $1;
2413       $hour += $hours;
2414     } else {
2415       return "unparsable frequency: ". $part_pkg->freq;
2416     }
2417     $cust_pkg->setfield('bill',
2418       timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year));
2419
2420   }
2421
2422   warn "\$setup is undefined" unless defined($setup);
2423   warn "\$recur is undefined" unless defined($recur);
2424   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
2425
2426   ###
2427   # If there's line items, create em cust_bill_pkg records
2428   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
2429   ###
2430
2431   if ( $lineitems ) {
2432
2433     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
2434       # hmm.. and if just the options are modified in some weird price plan?
2435
2436       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
2437         if $DEBUG >1;
2438
2439       my $error = $cust_pkg->replace( $old_cust_pkg,
2440                                       'options' => { $cust_pkg->options },
2441                                     );
2442       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
2443         if $error; #just in case
2444     }
2445
2446     $setup = sprintf( "%.2f", $setup );
2447     $recur = sprintf( "%.2f", $recur );
2448     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
2449       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
2450     }
2451     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
2452       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
2453     }
2454
2455     if ( $setup != 0 || $recur != 0 ) {
2456
2457       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
2458         if $DEBUG > 1;
2459
2460       my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
2461       if ( $DEBUG > 1 ) {
2462         warn "      adding customer package invoice detail: $_\n"
2463           foreach @cust_pkg_detail;
2464       }
2465       push @details, @cust_pkg_detail;
2466
2467       my $cust_bill_pkg = new FS::cust_bill_pkg {
2468         'pkgnum'    => $cust_pkg->pkgnum,
2469         'setup'     => $setup,
2470         'unitsetup' => $unitsetup,
2471         'recur'     => $recur,
2472         'unitrecur' => $unitrecur,
2473         'quantity'  => $cust_pkg->quantity,
2474         'details'   => \@details,
2475       };
2476
2477       if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
2478         $cust_bill_pkg->sdate( $hash{last_bill} );
2479         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
2480       } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
2481         $cust_bill_pkg->sdate( $sdate );
2482         $cust_bill_pkg->edate( $cust_pkg->bill );
2483       }
2484
2485       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
2486         unless $part_pkg->pkgpart == $real_pkgpart;
2487
2488       $$total_setup += $setup;
2489       $$total_recur += $recur;
2490
2491       ###
2492       # handle taxes
2493       ###
2494
2495       my $error =
2496         $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg);
2497       return $error if $error;
2498
2499       push @$cust_bill_pkgs, $cust_bill_pkg;
2500
2501     } #if $setup != 0 || $recur != 0
2502
2503   } #if $line_items
2504
2505   '';
2506
2507 }
2508
2509 sub _handle_taxes {
2510   my $self = shift;
2511   my $part_pkg = shift;
2512   my $taxlisthash = shift;
2513   my $cust_bill_pkg = shift;
2514   my $cust_pkg = shift;
2515
2516   my %cust_bill_pkg = ();
2517   my %taxes = ();
2518
2519   my $prefix =
2520     ( $conf->exists('tax-ship_address') && length($self->ship_last) )
2521     ? 'ship_'
2522     : '';
2523
2524   my @classes;
2525   #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
2526   push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
2527   push @classes, 'setup' if $cust_bill_pkg->setup;
2528   push @classes, 'recur' if $cust_bill_pkg->recur;
2529
2530   if ( $conf->exists('enable_taxproducts')
2531        && (scalar($part_pkg->part_pkg_taxoverride) || $part_pkg->has_taxproduct)
2532        && ( $self->tax !~ /Y/i && $self->payby ne 'COMP' )
2533      )
2534   {
2535
2536     foreach my $class (@classes) {
2537       my $err_or_ref = $self->_gather_taxes( $part_pkg, $class, $prefix );
2538       return $err_or_ref unless ref($err_or_ref);
2539       $taxes{$class} = $err_or_ref;
2540     }
2541
2542     unless (exists $taxes{''}) {
2543       my $err_or_ref = $self->_gather_taxes( $part_pkg, '', $prefix );
2544       return $err_or_ref unless ref($err_or_ref);
2545       $taxes{''} = $err_or_ref;
2546     }
2547
2548   } elsif ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
2549
2550     my %taxhash = map { $_ => $self->get("$prefix$_") }
2551                       qw( state county country );
2552
2553     $taxhash{'taxclass'} = $part_pkg->taxclass;
2554
2555     my @taxes = qsearch( 'cust_main_county', \%taxhash );
2556
2557     unless ( @taxes ) {
2558       $taxhash{'taxclass'} = '';
2559       @taxes =  qsearch( 'cust_main_county', \%taxhash );
2560     }
2561
2562     #one more try at a whole-country tax rate
2563     unless ( @taxes ) {
2564       $taxhash{$_} = '' foreach qw( state county );
2565       @taxes =  qsearch( 'cust_main_county', \%taxhash );
2566     }
2567
2568     $taxes{''} = [ @taxes ];
2569     $taxes{'setup'} = [ @taxes ];
2570     $taxes{'recur'} = [ @taxes ];
2571     $taxes{$_} = [ @taxes ] foreach (@classes);
2572
2573     # maybe eliminate this entirely, along with all the 0% records
2574     unless ( @taxes ) {
2575       return
2576         "fatal: can't find tax rate for state/county/country/taxclass ".
2577         join('/', ( map $self->get("$prefix$_"),
2578                         qw(state county country)
2579                   ),
2580                   $part_pkg->taxclass ). "\n";
2581     }
2582
2583   } #if $conf->exists('enable_taxproducts') ...
2584
2585   my @display = ();
2586   if ( $conf->exists('separate_usage') ) {
2587     my $section = $cust_pkg->part_pkg->option('usage_section', 'Hush!');
2588     my $summary = $cust_pkg->part_pkg->option('summarize_usage', 'Hush!');
2589     push @display, new FS::cust_bill_pkg_display { type    => 'S' };
2590     push @display, new FS::cust_bill_pkg_display { type    => 'R' };
2591     push @display, new FS::cust_bill_pkg_display { type    => 'U',
2592                                                    section => $section
2593                                                  };
2594     if ($section && $summary) {
2595       $display[2]->post_total('Y');
2596       push @display, new FS::cust_bill_pkg_display { type    => 'U',
2597                                                      summary => 'Y',
2598                                                    }
2599     }
2600   }
2601   $cust_bill_pkg->set('display', \@display);
2602
2603   my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
2604   foreach my $key (keys %tax_cust_bill_pkg) {
2605     my @taxes = @{ $taxes{$key} };
2606     my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
2607
2608     foreach my $tax ( @taxes ) {
2609       my $taxname = ref( $tax ). ' '. $tax->taxnum;
2610       if ( exists( $taxlisthash->{ $taxname } ) ) {
2611         push @{ $taxlisthash->{ $taxname  } }, $tax_cust_bill_pkg;
2612       }else{
2613         $taxlisthash->{ $taxname } = [ $tax, $tax_cust_bill_pkg ];
2614       }
2615     }
2616   }
2617
2618   '';
2619 }
2620
2621 sub _gather_taxes {
2622   my $self = shift;
2623   my $part_pkg = shift;
2624   my $class = shift;
2625   my $prefix = shift;
2626
2627   my @taxes = ();
2628   my $geocode = $self->geocode('cch');
2629
2630   my @taxclassnums = map { $_->taxclassnum }
2631                      $part_pkg->part_pkg_taxoverride($class);
2632
2633   unless (@taxclassnums) {
2634     @taxclassnums = map { $_->taxclassnum }
2635                     $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
2636   }
2637   warn "Found taxclassnum values of ". join(',', @taxclassnums)
2638     if $DEBUG;
2639
2640   my $extra_sql =
2641     "AND (".
2642     join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
2643
2644   @taxes = qsearch({ 'table' => 'tax_rate',
2645                      'hashref' => { 'geocode' => $geocode, },
2646                      'extra_sql' => $extra_sql,
2647                   })
2648     if scalar(@taxclassnums);
2649
2650   # maybe eliminate this entirely, along with all the 0% records
2651   unless ( @taxes ) {
2652     return
2653       "fatal: can't find tax rate for zip/taxproduct/pkgpart ".
2654       join('/', ( map $self->get("$prefix$_"),
2655                       qw(zip)
2656                 ),
2657                 $part_pkg->taxproduct_description,
2658                 $part_pkg->pkgpart ). "\n";
2659   }
2660
2661   warn "Found taxes ".
2662        join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
2663    if $DEBUG;
2664
2665   [ @taxes ];
2666
2667 }
2668
2669 =item collect OPTIONS
2670
2671 (Attempt to) collect money for this customer's outstanding invoices (see
2672 L<FS::cust_bill>).  Usually used after the bill method.
2673
2674 Actions are now triggered by billing events; see L<FS::part_event> and the
2675 billing events web interface.  Old-style invoice events (see
2676 L<FS::part_bill_event>) have been deprecated.
2677
2678 If there is an error, returns the error, otherwise returns false.
2679
2680 Options are passed as name-value pairs.
2681
2682 Currently available options are:
2683
2684 =over 4
2685
2686 =item invoice_time
2687
2688 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.
2689
2690 =item retry
2691
2692 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2693
2694 =item quiet
2695
2696 set true to surpress email card/ACH decline notices.
2697
2698 =item check_freq
2699
2700 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2701
2702 =item payby
2703
2704 allows for one time override of normal customer billing method
2705
2706 =item debug
2707
2708 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)
2709
2710
2711 =back
2712
2713 =cut
2714
2715 sub collect {
2716   my( $self, %options ) = @_;
2717   my $invoice_time = $options{'invoice_time'} || time;
2718
2719   #put below somehow?
2720   local $SIG{HUP} = 'IGNORE';
2721   local $SIG{INT} = 'IGNORE';
2722   local $SIG{QUIT} = 'IGNORE';
2723   local $SIG{TERM} = 'IGNORE';
2724   local $SIG{TSTP} = 'IGNORE';
2725   local $SIG{PIPE} = 'IGNORE';
2726
2727   my $oldAutoCommit = $FS::UID::AutoCommit;
2728   local $FS::UID::AutoCommit = 0;
2729   my $dbh = dbh;
2730
2731   $self->select_for_update; #mutex
2732
2733   if ( $DEBUG ) {
2734     my $balance = $self->balance;
2735     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
2736   }
2737
2738   if ( exists($options{'retry_card'}) ) {
2739     carp 'retry_card option passed to collect is deprecated; use retry';
2740     $options{'retry'} ||= $options{'retry_card'};
2741   }
2742   if ( exists($options{'retry'}) && $options{'retry'} ) {
2743     my $error = $self->retry_realtime;
2744     if ( $error ) {
2745       $dbh->rollback if $oldAutoCommit;
2746       return $error;
2747     }
2748   }
2749
2750   # false laziness w/pay_batch::import_results
2751
2752   my $due_cust_event = $self->due_cust_event(
2753     'debug'      => ( $options{'debug'} || 0 ),
2754     'time'       => $invoice_time,
2755     'check_freq' => $options{'check_freq'},
2756   );
2757   unless( ref($due_cust_event) ) {
2758     $dbh->rollback if $oldAutoCommit;
2759     return $due_cust_event;
2760   }
2761
2762   foreach my $cust_event ( @$due_cust_event ) {
2763
2764     #XXX lock event
2765
2766     #re-eval event conditions (a previous event could have changed things)
2767     unless ( $cust_event->test_conditions( 'time' => $invoice_time ) ) {
2768       #don't leave stray "new/locked" records around
2769       my $error = $cust_event->delete;
2770       if ( $error ) {
2771         #gah, even with transactions
2772         $dbh->commit if $oldAutoCommit; #well.
2773         return $error;
2774       }
2775       next;
2776     }
2777
2778     {
2779       local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2780       warn "  running cust_event ". $cust_event->eventnum. "\n"
2781         if $DEBUG > 1;
2782
2783
2784       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2785       if ( my $error = $cust_event->do_event() ) {
2786         #XXX wtf is this?  figure out a proper dealio with return value
2787         #from do_event
2788           # gah, even with transactions.
2789           $dbh->commit if $oldAutoCommit; #well.
2790           return $error;
2791         }
2792     }
2793
2794   }
2795
2796   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2797   '';
2798
2799 }
2800
2801 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2802
2803 Inserts database records for and returns an ordered listref of new events due
2804 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
2805 events are due, an empty listref is returned.  If there is an error, returns a
2806 scalar error message.
2807
2808 To actually run the events, call each event's test_condition method, and if
2809 still true, call the event's do_event method.
2810
2811 Options are passed as a hashref or as a list of name-value pairs.  Available
2812 options are:
2813
2814 =over 4
2815
2816 =item check_freq
2817
2818 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.
2819
2820 =item time
2821
2822 "Current time" for the events.
2823
2824 =item debug
2825
2826 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)
2827
2828 =item eventtable
2829
2830 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2831
2832 =item objects
2833
2834 Explicitly pass the objects to be tested (typically used with eventtable).
2835
2836 =back
2837
2838 =cut
2839
2840 sub due_cust_event {
2841   my $self = shift;
2842   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2843
2844   #???
2845   #my $DEBUG = $opt{'debug'}
2846   local($DEBUG) = $opt{'debug'}
2847     if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
2848
2849   warn "$me due_cust_event called with options ".
2850        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2851     if $DEBUG;
2852
2853   $opt{'time'} ||= time;
2854
2855   local $SIG{HUP} = 'IGNORE';
2856   local $SIG{INT} = 'IGNORE';
2857   local $SIG{QUIT} = 'IGNORE';
2858   local $SIG{TERM} = 'IGNORE';
2859   local $SIG{TSTP} = 'IGNORE';
2860   local $SIG{PIPE} = 'IGNORE';
2861
2862   my $oldAutoCommit = $FS::UID::AutoCommit;
2863   local $FS::UID::AutoCommit = 0;
2864   my $dbh = dbh;
2865
2866   $self->select_for_update; #mutex
2867
2868   ###
2869   # 1: find possible events (initial search)
2870   ###
2871
2872   my @cust_event = ();
2873
2874   my @eventtable = $opt{'eventtable'}
2875                      ? ( $opt{'eventtable'} )
2876                      : FS::part_event->eventtables_runorder;
2877
2878   foreach my $eventtable ( @eventtable ) {
2879
2880     my @objects;
2881     if ( $opt{'objects'} ) {
2882
2883       @objects = @{ $opt{'objects'} };
2884
2885     } else {
2886
2887       #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
2888       @objects = ( $eventtable eq 'cust_main' )
2889                    ? ( $self )
2890                    : ( $self->$eventtable() );
2891
2892     }
2893
2894     my @e_cust_event = ();
2895
2896     my $cross = "CROSS JOIN $eventtable";
2897     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2898       unless $eventtable eq 'cust_main';
2899
2900     foreach my $object ( @objects ) {
2901
2902       #this first search uses the condition_sql magic for optimization.
2903       #the more possible events we can eliminate in this step the better
2904
2905       my $cross_where = '';
2906       my $pkey = $object->primary_key;
2907       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2908
2909       my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
2910       my $extra_sql =
2911         FS::part_event_condition->where_conditions_sql( $eventtable,
2912                                                         'time'=>$opt{'time'}
2913                                                       );
2914       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2915
2916       $extra_sql = "AND $extra_sql" if $extra_sql;
2917
2918       #here is the agent virtualization
2919       $extra_sql .= " AND (    part_event.agentnum IS NULL
2920                             OR part_event.agentnum = ". $self->agentnum. ' )';
2921
2922       $extra_sql .= " $order";
2923
2924       warn "searching for events for $eventtable ". $object->$pkey. "\n"
2925         if $opt{'debug'} > 2;
2926       my @part_event = qsearch( {
2927         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
2928         'select'    => 'part_event.*',
2929         'table'     => 'part_event',
2930         'addl_from' => "$cross $join",
2931         'hashref'   => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
2932                          'eventtable' => $eventtable,
2933                          'disabled'   => '',
2934                        },
2935         'extra_sql' => "AND $cross_where $extra_sql",
2936       } );
2937
2938       if ( $DEBUG > 2 ) {
2939         my $pkey = $object->primary_key;
2940         warn "      ". scalar(@part_event).
2941              " possible events found for $eventtable ". $object->$pkey(). "\n";
2942       }
2943
2944       push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
2945
2946     }
2947
2948     warn "    ". scalar(@e_cust_event).
2949          " subtotal possible cust events found for $eventtable\n"
2950       if $DEBUG > 1;
2951
2952     push @cust_event, @e_cust_event;
2953
2954   }
2955
2956   warn "  ". scalar(@cust_event).
2957        " total possible cust events found in initial search\n"
2958     if $DEBUG; # > 1;
2959
2960   ##
2961   # 2: test conditions
2962   ##
2963
2964   my %unsat = ();
2965
2966   @cust_event = grep $_->test_conditions( 'time'          => $opt{'time'},
2967                                           'stats_hashref' => \%unsat ),
2968                      @cust_event;
2969
2970   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
2971     if $DEBUG; # > 1;
2972
2973   warn "    invalid conditions not eliminated with condition_sql:\n".
2974        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
2975     if $DEBUG; # > 1;
2976
2977   ##
2978   # 3: insert
2979   ##
2980
2981   unless( $opt{testonly} ) {
2982     foreach my $cust_event ( @cust_event ) {
2983
2984       my $error = $cust_event->insert();
2985       if ( $error ) {
2986         $dbh->rollback if $oldAutoCommit;
2987         return $error;
2988       }
2989
2990     }
2991   }
2992
2993   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2994
2995   ##
2996   # 4: return
2997   ##
2998
2999   warn "  returning events: ". Dumper(@cust_event). "\n"
3000     if $DEBUG > 2;
3001
3002   \@cust_event;
3003
3004 }
3005
3006 =item retry_realtime
3007
3008 Schedules realtime / batch  credit card / electronic check / LEC billing
3009 events for for retry.  Useful if card information has changed or manual
3010 retry is desired.  The 'collect' method must be called to actually retry
3011 the transaction.
3012
3013 Implementation details: For either this customer, or for each of this
3014 customer's open invoices, changes the status of the first "done" (with
3015 statustext error) realtime processing event to "failed".
3016
3017 =cut
3018
3019 sub retry_realtime {
3020   my $self = shift;
3021
3022   local $SIG{HUP} = 'IGNORE';
3023   local $SIG{INT} = 'IGNORE';
3024   local $SIG{QUIT} = 'IGNORE';
3025   local $SIG{TERM} = 'IGNORE';
3026   local $SIG{TSTP} = 'IGNORE';
3027   local $SIG{PIPE} = 'IGNORE';
3028
3029   my $oldAutoCommit = $FS::UID::AutoCommit;
3030   local $FS::UID::AutoCommit = 0;
3031   my $dbh = dbh;
3032
3033   #a little false laziness w/due_cust_event (not too bad, really)
3034
3035   my $join = FS::part_event_condition->join_conditions_sql;
3036   my $order = FS::part_event_condition->order_conditions_sql;
3037   my $mine =
3038   '( '
3039    . join ( ' OR ' , map {
3040     "( part_event.eventtable = " . dbh->quote($_)
3041     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3042    } FS::part_event->eventtables)
3043    . ') ';
3044
3045   #here is the agent virtualization
3046   my $agent_virt = " (    part_event.agentnum IS NULL
3047                        OR part_event.agentnum = ". $self->agentnum. ' )';
3048
3049   #XXX this shouldn't be hardcoded, actions should declare it...
3050   my @realtime_events = qw(
3051     cust_bill_realtime_card
3052     cust_bill_realtime_check
3053     cust_bill_realtime_lec
3054     cust_bill_batch
3055   );
3056
3057   my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3058                                                   @realtime_events
3059                                      ).
3060                           ' ) ';
3061
3062   my @cust_event = qsearchs({
3063     'table'     => 'cust_event',
3064     'select'    => 'cust_event.*',
3065     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3066     'hashref'   => { 'status' => 'done' },
3067     'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3068                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3069   });
3070
3071   my %seen_invnum = ();
3072   foreach my $cust_event (@cust_event) {
3073
3074     #max one for the customer, one for each open invoice
3075     my $cust_X = $cust_event->cust_X;
3076     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3077                           ? $cust_X->invnum
3078                           : 0
3079                         }++
3080          or $cust_event->part_event->eventtable eq 'cust_bill'
3081             && ! $cust_X->owed;
3082
3083     my $error = $cust_event->retry;
3084     if ( $error ) {
3085       $dbh->rollback if $oldAutoCommit;
3086       return "error scheduling event for retry: $error";
3087     }
3088
3089   }
3090
3091   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3092   '';
3093
3094 }
3095
3096 =item realtime_bop METHOD AMOUNT [ OPTION => VALUE ... ]
3097
3098 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
3099 via a Business::OnlinePayment realtime gateway.  See
3100 L<http://420.am/business-onlinepayment> for supported gateways.
3101
3102 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3103
3104 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
3105
3106 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3107 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
3108 if set, will override the value from the customer record.
3109
3110 I<description> is a free-text field passed to the gateway.  It defaults to
3111 "Internet services".
3112
3113 If an I<invnum> is specified, this payment (if successful) is applied to the
3114 specified invoice.  If you don't specify an I<invnum> you might want to
3115 call the B<apply_payments> method.
3116
3117 I<quiet> can be set true to surpress email decline notices.
3118
3119 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
3120 resulting paynum, if any.
3121
3122 I<payunique> is a unique identifier for this payment.
3123
3124 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
3125
3126 =cut
3127
3128 sub realtime_bop {
3129   my( $self, $method, $amount, %options ) = @_;
3130   if ( $DEBUG ) {
3131     warn "$me realtime_bop: $method $amount\n";
3132     warn "  $_ => $options{$_}\n" foreach keys %options;
3133   }
3134
3135   $options{'description'} ||= 'Internet services';
3136
3137   return $self->fake_bop($method, $amount, %options) if $options{'fake'};
3138
3139   eval "use Business::OnlinePayment";
3140   die $@ if $@;
3141
3142   my $payinfo = exists($options{'payinfo'})
3143                   ? $options{'payinfo'}
3144                   : $self->payinfo;
3145
3146   my %method2payby = (
3147     'CC'     => 'CARD',
3148     'ECHECK' => 'CHEK',
3149     'LEC'    => 'LECB',
3150   );
3151
3152   ###
3153   # check for banned credit card/ACH
3154   ###
3155
3156   my $ban = qsearchs('banned_pay', {
3157     'payby'   => $method2payby{$method},
3158     'payinfo' => md5_base64($payinfo),
3159   } );
3160   return "Banned credit card" if $ban;
3161
3162   ###
3163   # select a gateway
3164   ###
3165
3166   my $taxclass = '';
3167   if ( $options{'invnum'} ) {
3168     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
3169     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
3170     my @taxclasses =
3171       map  { $_->part_pkg->taxclass }
3172       grep { $_ }
3173       map  { $_->cust_pkg }
3174       $cust_bill->cust_bill_pkg;
3175     unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are
3176                                                            #different taxclasses
3177       $taxclass = $taxclasses[0];
3178     }
3179   }
3180
3181   #look for an agent gateway override first
3182   my $cardtype;
3183   if ( $method eq 'CC' ) {
3184     $cardtype = cardtype($payinfo);
3185   } elsif ( $method eq 'ECHECK' ) {
3186     $cardtype = 'ACH';
3187   } else {
3188     $cardtype = $method;
3189   }
3190
3191   my $override =
3192        qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3193                                            cardtype => $cardtype,
3194                                            taxclass => $taxclass,       } )
3195     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3196                                            cardtype => '',
3197                                            taxclass => $taxclass,       } )
3198     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3199                                            cardtype => $cardtype,
3200                                            taxclass => '',              } )
3201     || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3202                                            cardtype => '',
3203                                            taxclass => '',              } );
3204
3205   my $payment_gateway = '';
3206   my( $processor, $login, $password, $action, @bop_options );
3207   if ( $override ) { #use a payment gateway override
3208
3209     $payment_gateway = $override->payment_gateway;
3210
3211     $processor   = $payment_gateway->gateway_module;
3212     $login       = $payment_gateway->gateway_username;
3213     $password    = $payment_gateway->gateway_password;
3214     $action      = $payment_gateway->gateway_action;
3215     @bop_options = $payment_gateway->options;
3216
3217   } else { #use the standard settings from the config
3218
3219     ( $processor, $login, $password, $action, @bop_options ) =
3220       $self->default_payment_gateway($method);
3221
3222   }
3223
3224   ###
3225   # massage data
3226   ###
3227
3228   my $address = exists($options{'address1'})
3229                     ? $options{'address1'}
3230                     : $self->address1;
3231   my $address2 = exists($options{'address2'})
3232                     ? $options{'address2'}
3233                     : $self->address2;
3234   $address .= ", ". $address2 if length($address2);
3235
3236   my $o_payname = exists($options{'payname'})
3237                     ? $options{'payname'}
3238                     : $self->payname;
3239   my($payname, $payfirst, $paylast);
3240   if ( $o_payname && $method ne 'ECHECK' ) {
3241     ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3242       or return "Illegal payname $payname";
3243     ($payfirst, $paylast) = ($1, $2);
3244   } else {
3245     $payfirst = $self->getfield('first');
3246     $paylast = $self->getfield('last');
3247     $payname =  "$payfirst $paylast";
3248   }
3249
3250   my @invoicing_list = $self->invoicing_list_emailonly;
3251   if ( $conf->exists('emailinvoiceautoalways')
3252        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3253        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3254     push @invoicing_list, $self->all_emails;
3255   }
3256
3257   my $email = ($conf->exists('business-onlinepayment-email-override'))
3258               ? $conf->config('business-onlinepayment-email-override')
3259               : $invoicing_list[0];
3260
3261   my %content = ();
3262
3263   my $payip = exists($options{'payip'})
3264                 ? $options{'payip'}
3265                 : $self->payip;
3266   $content{customer_ip} = $payip
3267     if length($payip);
3268
3269   $content{invoice_number} = $options{'invnum'}
3270     if exists($options{'invnum'}) && length($options{'invnum'});
3271
3272   $content{email_customer} =
3273     (    $conf->exists('business-onlinepayment-email_customer')
3274       || $conf->exists('business-onlinepayment-email-override') );
3275
3276   my $paydate = '';
3277   if ( $method eq 'CC' ) {
3278
3279     $content{card_number} = $payinfo;
3280     $paydate = exists($options{'paydate'})
3281                     ? $options{'paydate'}
3282                     : $self->paydate;
3283     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
3284     $content{expiration} = "$2/$1";
3285
3286     my $paycvv = exists($options{'paycvv'})
3287                    ? $options{'paycvv'}
3288                    : $self->paycvv;
3289     $content{cvv2} = $paycvv
3290       if length($paycvv);
3291
3292     my $paystart_month = exists($options{'paystart_month'})
3293                            ? $options{'paystart_month'}
3294                            : $self->paystart_month;
3295
3296     my $paystart_year  = exists($options{'paystart_year'})
3297                            ? $options{'paystart_year'}
3298                            : $self->paystart_year;
3299
3300     $content{card_start} = "$paystart_month/$paystart_year"
3301       if $paystart_month && $paystart_year;
3302
3303     my $payissue       = exists($options{'payissue'})
3304                            ? $options{'payissue'}
3305                            : $self->payissue;
3306     $content{issue_number} = $payissue if $payissue;
3307
3308     $content{recurring_billing} = 'YES'
3309       if qsearch('cust_pay', { 'custnum' => $self->custnum,
3310                                'payby'   => 'CARD',
3311                                'payinfo' => $payinfo,
3312                              } )
3313       || qsearch('cust_pay', { 'custnum' => $self->custnum,
3314                                'payby'   => 'CARD',
3315                                'paymask' => $self->mask_payinfo('CARD', $payinfo),
3316                              } );
3317
3318
3319   } elsif ( $method eq 'ECHECK' ) {
3320     ( $content{account_number}, $content{routing_code} ) =
3321       split('@', $payinfo);
3322     $content{bank_name} = $o_payname;
3323     $content{bank_state} = exists($options{'paystate'})
3324                              ? $options{'paystate'}
3325                              : $self->getfield('paystate');
3326     $content{account_type} = exists($options{'paytype'})
3327                                ? uc($options{'paytype'}) || 'CHECKING'
3328                                : uc($self->getfield('paytype')) || 'CHECKING';
3329     $content{account_name} = $payname;
3330     $content{customer_org} = $self->company ? 'B' : 'I';
3331     $content{state_id}       = exists($options{'stateid'})
3332                                  ? $options{'stateid'}
3333                                  : $self->getfield('stateid');
3334     $content{state_id_state} = exists($options{'stateid_state'})
3335                                  ? $options{'stateid_state'}
3336                                  : $self->getfield('stateid_state');
3337     $content{customer_ssn} = exists($options{'ss'})
3338                                ? $options{'ss'}
3339                                : $self->ss;
3340   } elsif ( $method eq 'LEC' ) {
3341     $content{phone} = $payinfo;
3342   }
3343
3344   ###
3345   # run transaction(s)
3346   ###
3347
3348   my $balance = exists( $options{'balance'} )
3349                   ? $options{'balance'}
3350                   : $self->balance;
3351
3352   $self->select_for_update; #mutex ... just until we get our pending record in
3353
3354   #the checks here are intended to catch concurrent payments
3355   #double-form-submission prevention is taken care of in cust_pay_pending::check
3356
3357   #check the balance
3358   return "The customer's balance has changed; $method transaction aborted."
3359     if $self->balance < $balance;
3360     #&& $self->balance < $amount; #might as well anyway?
3361
3362   #also check and make sure there aren't *other* pending payments for this cust
3363
3364   my @pending = qsearch('cust_pay_pending', {
3365     'custnum' => $self->custnum,
3366     'status'  => { op=>'!=', value=>'done' }
3367   });
3368   return "A payment is already being processed for this customer (".
3369          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
3370          "); $method transaction aborted."
3371     if scalar(@pending);
3372
3373   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
3374
3375   my $cust_pay_pending = new FS::cust_pay_pending {
3376     'custnum'    => $self->custnum,
3377     #'invnum'     => $options{'invnum'},
3378     'paid'       => $amount,
3379     '_date'      => '',
3380     'payby'      => $method2payby{$method},
3381     'payinfo'    => $payinfo,
3382     'paydate'    => $paydate,
3383     'status'     => 'new',
3384     'gatewaynum' => ( $payment_gateway ? $payment_gateway->gatewaynum : '' ),
3385   };
3386   $cust_pay_pending->payunique( $options{payunique} )
3387     if defined($options{payunique}) && length($options{payunique});
3388   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
3389   return $cpp_new_err if $cpp_new_err;
3390
3391   my( $action1, $action2 ) = split(/\s*\,\s*/, $action );
3392
3393   my $transaction = new Business::OnlinePayment( $processor, @bop_options );
3394   $transaction->content(
3395     'type'           => $method,
3396     'login'          => $login,
3397     'password'       => $password,
3398     'action'         => $action1,
3399     'description'    => $options{'description'},
3400     'amount'         => $amount,
3401     #'invoice_number' => $options{'invnum'},
3402     'customer_id'    => $self->custnum,
3403     'last_name'      => $paylast,
3404     'first_name'     => $payfirst,
3405     'name'           => $payname,
3406     'address'        => $address,
3407     'city'           => ( exists($options{'city'})
3408                             ? $options{'city'}
3409                             : $self->city          ),
3410     'state'          => ( exists($options{'state'})
3411                             ? $options{'state'}
3412                             : $self->state          ),
3413     'zip'            => ( exists($options{'zip'})
3414                             ? $options{'zip'}
3415                             : $self->zip          ),
3416     'country'        => ( exists($options{'country'})
3417                             ? $options{'country'}
3418                             : $self->country          ),
3419     'referer'        => 'http://cleanwhisker.420.am/',
3420     'email'          => $email,
3421     'phone'          => $self->daytime || $self->night,
3422     %content, #after
3423   );
3424
3425   $cust_pay_pending->status('pending');
3426   my $cpp_pending_err = $cust_pay_pending->replace;
3427   return $cpp_pending_err if $cpp_pending_err;
3428
3429   #config?
3430   my $BOP_TESTING = 0;
3431   my $BOP_TESTING_SUCCESS = 1;
3432
3433   unless ( $BOP_TESTING ) {
3434     $transaction->submit();
3435   } else {
3436     if ( $BOP_TESTING_SUCCESS ) {
3437       $transaction->is_success(1);
3438       $transaction->authorization('fake auth');
3439     } else {
3440       $transaction->is_success(0);
3441       $transaction->error_message('fake failure');
3442     }
3443   }
3444
3445   if ( $transaction->is_success() && $action2 ) {
3446
3447     $cust_pay_pending->status('authorized');
3448     my $cpp_authorized_err = $cust_pay_pending->replace;
3449     return $cpp_authorized_err if $cpp_authorized_err;
3450
3451     my $auth = $transaction->authorization;
3452     my $ordernum = $transaction->can('order_number')
3453                    ? $transaction->order_number
3454                    : '';
3455
3456     my $capture =
3457       new Business::OnlinePayment( $processor, @bop_options );
3458
3459     my %capture = (
3460       %content,
3461       type           => $method,
3462       action         => $action2,
3463       login          => $login,
3464       password       => $password,
3465       order_number   => $ordernum,
3466       amount         => $amount,
3467       authorization  => $auth,
3468       description    => $options{'description'},
3469     );
3470
3471     foreach my $field (qw( authorization_source_code returned_ACI
3472                            transaction_identifier validation_code
3473                            transaction_sequence_num local_transaction_date
3474                            local_transaction_time AVS_result_code          )) {
3475       $capture{$field} = $transaction->$field() if $transaction->can($field);
3476     }
3477
3478     $capture->content( %capture );
3479
3480     $capture->submit();
3481
3482     unless ( $capture->is_success ) {
3483       my $e = "Authorization successful but capture failed, custnum #".
3484               $self->custnum. ': '.  $capture->result_code.
3485               ": ". $capture->error_message;
3486       warn $e;
3487       return $e;
3488     }
3489
3490   }
3491
3492   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
3493   my $cpp_captured_err = $cust_pay_pending->replace;
3494   return $cpp_captured_err if $cpp_captured_err;
3495
3496   ###
3497   # remove paycvv after initial transaction
3498   ###
3499
3500   #false laziness w/misc/process/payment.cgi - check both to make sure working
3501   # correctly
3502   if ( defined $self->dbdef_table->column('paycvv')
3503        && length($self->paycvv)
3504        && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
3505   ) {
3506     my $error = $self->remove_cvv;
3507     if ( $error ) {
3508       warn "WARNING: error removing cvv: $error\n";
3509     }
3510   }
3511
3512   ###
3513   # result handling
3514   ###
3515
3516   if ( $transaction->is_success() ) {
3517
3518     my $paybatch = '';
3519     if ( $payment_gateway ) { # agent override
3520       $paybatch = $payment_gateway->gatewaynum. '-';
3521     }
3522
3523     $paybatch .= "$processor:". $transaction->authorization;
3524
3525     $paybatch .= ':'. $transaction->order_number
3526       if $transaction->can('order_number')
3527       && length($transaction->order_number);
3528
3529     my $cust_pay = new FS::cust_pay ( {
3530        'custnum'  => $self->custnum,
3531        'invnum'   => $options{'invnum'},
3532        'paid'     => $amount,
3533        '_date'    => '',
3534        'payby'    => $method2payby{$method},
3535        'payinfo'  => $payinfo,
3536        'paybatch' => $paybatch,
3537        'paydate'  => $paydate,
3538     } );
3539     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
3540     $cust_pay->payunique( $options{payunique} )
3541       if defined($options{payunique}) && length($options{payunique});
3542
3543     my $oldAutoCommit = $FS::UID::AutoCommit;
3544     local $FS::UID::AutoCommit = 0;
3545     my $dbh = dbh;
3546
3547     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
3548
3549     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3550
3551     if ( $error ) {
3552       $cust_pay->invnum(''); #try again with no specific invnum
3553       my $error2 = $cust_pay->insert( $options{'manual'} ?
3554                                       ( 'manual' => 1 ) : ()
3555                                     );
3556       if ( $error2 ) {
3557         # gah.  but at least we have a record of the state we had to abort in
3558         # from cust_pay_pending now.
3559         my $e = "WARNING: $method captured but payment not recorded - ".
3560                 "error inserting payment ($processor): $error2".
3561                 " (previously tried insert with invnum #$options{'invnum'}" .
3562                 ": $error ) - pending payment saved as paypendingnum ".
3563                 $cust_pay_pending->paypendingnum. "\n";
3564         warn $e;
3565         return $e;
3566       }
3567     }
3568
3569     if ( $options{'paynum_ref'} ) {
3570       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3571     }
3572
3573     $cust_pay_pending->status('done');
3574     $cust_pay_pending->statustext('captured');
3575     my $cpp_done_err = $cust_pay_pending->replace;
3576
3577     if ( $cpp_done_err ) {
3578
3579       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
3580       my $e = "WARNING: $method captured but payment not recorded - ".
3581               "error updating status for paypendingnum ".
3582               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3583       warn $e;
3584       return $e;
3585
3586     } else {
3587
3588       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3589       return ''; #no error
3590
3591     }
3592
3593   } else {
3594
3595     my $perror = "$processor error: ". $transaction->error_message;
3596
3597     unless ( $transaction->error_message ) {
3598
3599       my $t_response;
3600       if ( $transaction->can('response_page') ) {
3601         $t_response = {
3602                         'page'    => ( $transaction->can('response_page')
3603                                          ? $transaction->response_page
3604                                          : ''
3605                                      ),
3606                         'code'    => ( $transaction->can('response_code')
3607                                          ? $transaction->response_code
3608                                          : ''
3609                                      ),
3610                         'headers' => ( $transaction->can('response_headers')
3611                                          ? $transaction->response_headers
3612                                          : ''
3613                                      ),
3614                       };
3615       } else {
3616         $t_response .=
3617           "No additional debugging information available for $processor";
3618       }
3619
3620       $perror .= "No error_message returned from $processor -- ".
3621                  ( ref($t_response) ? Dumper($t_response) : $t_response );
3622
3623     }
3624
3625     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
3626          && $conf->exists('emaildecline')
3627          && grep { $_ ne 'POST' } $self->invoicing_list
3628          && ! grep { $transaction->error_message =~ /$_/ }
3629                    $conf->config('emaildecline-exclude')
3630     ) {
3631       my @templ = $conf->config('declinetemplate');
3632       my $template = new Text::Template (
3633         TYPE   => 'ARRAY',
3634         SOURCE => [ map "$_\n", @templ ],
3635       ) or return "($perror) can't create template: $Text::Template::ERROR";
3636       $template->compile()
3637         or return "($perror) can't compile template: $Text::Template::ERROR";
3638
3639       my $templ_hash = { error => $transaction->error_message };
3640
3641       my $error = send_email(
3642         'from'    => $conf->config('invoice_from'),
3643         'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
3644         'subject' => 'Your payment could not be processed',
3645         'body'    => [ $template->fill_in(HASH => $templ_hash) ],
3646       );
3647
3648       $perror .= " (also received error sending decline notification: $error)"
3649         if $error;
3650
3651     }
3652
3653     $cust_pay_pending->status('done');
3654     $cust_pay_pending->statustext("declined: $perror");
3655     my $cpp_done_err = $cust_pay_pending->replace;
3656     if ( $cpp_done_err ) {
3657       my $e = "WARNING: $method declined but pending payment not resolved - ".
3658               "error updating status for paypendingnum ".
3659               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
3660       warn $e;
3661       $perror = "$e ($perror)";
3662     }
3663
3664     return $perror;
3665   }
3666
3667 }
3668
3669 =item fake_bop
3670
3671 =cut
3672
3673 sub fake_bop {
3674   my( $self, $method, $amount, %options ) = @_;
3675
3676   if ( $options{'fake_failure'} ) {
3677      return "Error: No error; test failure requested with fake_failure";
3678   }
3679
3680   my %method2payby = (
3681     'CC'     => 'CARD',
3682     'ECHECK' => 'CHEK',
3683     'LEC'    => 'LECB',
3684   );
3685
3686   #my $paybatch = '';
3687   #if ( $payment_gateway ) { # agent override
3688   #  $paybatch = $payment_gateway->gatewaynum. '-';
3689   #}
3690   #
3691   #$paybatch .= "$processor:". $transaction->authorization;
3692   #
3693   #$paybatch .= ':'. $transaction->order_number
3694   #  if $transaction->can('order_number')
3695   #  && length($transaction->order_number);
3696
3697   my $paybatch = 'FakeProcessor:54:32';
3698
3699   my $cust_pay = new FS::cust_pay ( {
3700      'custnum'  => $self->custnum,
3701      'invnum'   => $options{'invnum'},
3702      'paid'     => $amount,
3703      '_date'    => '',
3704      'payby'    => $method2payby{$method},
3705      #'payinfo'  => $payinfo,
3706      'payinfo'  => '4111111111111111',
3707      'paybatch' => $paybatch,
3708      #'paydate'  => $paydate,
3709      'paydate'  => '2012-05-01',
3710   } );
3711   $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
3712
3713   my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
3714
3715   if ( $error ) {
3716     $cust_pay->invnum(''); #try again with no specific invnum
3717     my $error2 = $cust_pay->insert( $options{'manual'} ?
3718                                     ( 'manual' => 1 ) : ()
3719                                   );
3720     if ( $error2 ) {
3721       # gah, even with transactions.
3722       my $e = 'WARNING: Card/ACH debited but database not updated - '.
3723               "error inserting (fake!) payment: $error2".
3724               " (previously tried insert with invnum #$options{'invnum'}" .
3725               ": $error )";
3726       warn $e;
3727       return $e;
3728     }
3729   }
3730
3731   if ( $options{'paynum_ref'} ) {
3732     ${ $options{'paynum_ref'} } = $cust_pay->paynum;
3733   }
3734
3735   return ''; #no error
3736
3737 }
3738
3739 =item default_payment_gateway
3740
3741 =cut
3742
3743 sub default_payment_gateway {
3744   my( $self, $method ) = @_;
3745
3746   die "Real-time processing not enabled\n"
3747     unless $conf->exists('business-onlinepayment');
3748
3749   #load up config
3750   my $bop_config = 'business-onlinepayment';
3751   $bop_config .= '-ach'
3752     if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
3753   my ( $processor, $login, $password, $action, @bop_options ) =
3754     $conf->config($bop_config);
3755   $action ||= 'normal authorization';
3756   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
3757   die "No real-time processor is enabled - ".
3758       "did you set the business-onlinepayment configuration value?\n"
3759     unless $processor;
3760
3761   ( $processor, $login, $password, $action, @bop_options )
3762 }
3763
3764 =item remove_cvv
3765
3766 Removes the I<paycvv> field from the database directly.
3767
3768 If there is an error, returns the error, otherwise returns false.
3769
3770 =cut
3771
3772 sub remove_cvv {
3773   my $self = shift;
3774   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
3775     or return dbh->errstr;
3776   $sth->execute($self->custnum)
3777     or return $sth->errstr;
3778   $self->paycvv('');
3779   '';
3780 }
3781
3782 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
3783
3784 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
3785 via a Business::OnlinePayment realtime gateway.  See
3786 L<http://420.am/business-onlinepayment> for supported gateways.
3787
3788 Available methods are: I<CC>, I<ECHECK> and I<LEC>
3789
3790 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
3791
3792 Most gateways require a reference to an original payment transaction to refund,
3793 so you probably need to specify a I<paynum>.
3794
3795 I<amount> defaults to the original amount of the payment if not specified.
3796
3797 I<reason> specifies a reason for the refund.
3798
3799 I<paydate> specifies the expiration date for a credit card overriding the
3800 value from the customer record or the payment record. Specified as yyyy-mm-dd
3801
3802 Implementation note: If I<amount> is unspecified or equal to the amount of the
3803 orignal payment, first an attempt is made to "void" the transaction via
3804 the gateway (to cancel a not-yet settled transaction) and then if that fails,
3805 the normal attempt is made to "refund" ("credit") the transaction via the
3806 gateway is attempted.
3807
3808 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
3809 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
3810 #if set, will override the value from the customer record.
3811
3812 #If an I<invnum> is specified, this payment (if successful) is applied to the
3813 #specified invoice.  If you don't specify an I<invnum> you might want to
3814 #call the B<apply_payments> method.
3815
3816 =cut
3817
3818 #some false laziness w/realtime_bop, not enough to make it worth merging
3819 #but some useful small subs should be pulled out
3820 sub realtime_refund_bop {
3821   my( $self, $method, %options ) = @_;
3822   if ( $DEBUG ) {
3823     warn "$me realtime_refund_bop: $method refund\n";
3824     warn "  $_ => $options{$_}\n" foreach keys %options;
3825   }
3826
3827   eval "use Business::OnlinePayment";
3828   die $@ if $@;
3829
3830   ###
3831   # look up the original payment and optionally a gateway for that payment
3832   ###
3833
3834   my $cust_pay = '';
3835   my $amount = $options{'amount'};
3836
3837   my( $processor, $login, $password, @bop_options ) ;
3838   my( $auth, $order_number ) = ( '', '', '' );
3839
3840   if ( $options{'paynum'} ) {
3841
3842     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
3843     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
3844       or return "Unknown paynum $options{'paynum'}";
3845     $amount ||= $cust_pay->paid;
3846
3847     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
3848       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
3849                 $cust_pay->paybatch;
3850     my $gatewaynum = '';
3851     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
3852
3853     if ( $gatewaynum ) { #gateway for the payment to be refunded
3854
3855       my $payment_gateway =
3856         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
3857       die "payment gateway $gatewaynum not found"
3858         unless $payment_gateway;
3859
3860       $processor   = $payment_gateway->gateway_module;
3861       $login       = $payment_gateway->gateway_username;
3862       $password    = $payment_gateway->gateway_password;
3863       @bop_options = $payment_gateway->options;
3864
3865     } else { #try the default gateway
3866
3867       my( $conf_processor, $unused_action );
3868       ( $conf_processor, $login, $password, $unused_action, @bop_options ) =
3869         $self->default_payment_gateway($method);
3870
3871       return "processor of payment $options{'paynum'} $processor does not".
3872              " match default processor $conf_processor"
3873         unless $processor eq $conf_processor;
3874
3875     }
3876
3877
3878   } else { # didn't specify a paynum, so look for agent gateway overrides
3879            # like a normal transaction
3880
3881     my $cardtype;
3882     if ( $method eq 'CC' ) {
3883       $cardtype = cardtype($self->payinfo);
3884     } elsif ( $method eq 'ECHECK' ) {
3885       $cardtype = 'ACH';
3886     } else {
3887       $cardtype = $method;
3888     }
3889     my $override =
3890            qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3891                                                cardtype => $cardtype,
3892                                                taxclass => '',              } )
3893         || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum,
3894                                                cardtype => '',
3895                                                taxclass => '',              } );
3896
3897     if ( $override ) { #use a payment gateway override
3898
3899       my $payment_gateway = $override->payment_gateway;
3900
3901       $processor   = $payment_gateway->gateway_module;
3902       $login       = $payment_gateway->gateway_username;
3903       $password    = $payment_gateway->gateway_password;
3904       #$action      = $payment_gateway->gateway_action;
3905       @bop_options = $payment_gateway->options;
3906
3907     } else { #use the standard settings from the config
3908
3909       my $unused_action;
3910       ( $processor, $login, $password, $unused_action, @bop_options ) =
3911         $self->default_payment_gateway($method);
3912
3913     }
3914
3915   }
3916   return "neither amount nor paynum specified" unless $amount;
3917
3918   my %content = (
3919     'type'           => $method,
3920     'login'          => $login,
3921     'password'       => $password,
3922     'order_number'   => $order_number,
3923     'amount'         => $amount,
3924     'referer'        => 'http://cleanwhisker.420.am/',
3925   );
3926   $content{authorization} = $auth
3927     if length($auth); #echeck/ACH transactions have an order # but no auth
3928                       #(at least with authorize.net)
3929
3930   my $disable_void_after;
3931   if ($conf->exists('disable_void_after')
3932       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
3933     $disable_void_after = $1;
3934   }
3935
3936   #first try void if applicable
3937   if ( $cust_pay && $cust_pay->paid == $amount
3938     && (
3939       ( not defined($disable_void_after) )
3940       || ( time < ($cust_pay->_date + $disable_void_after ) )
3941     )
3942   ) {
3943     warn "  attempting void\n" if $DEBUG > 1;
3944     my $void = new Business::OnlinePayment( $processor, @bop_options );
3945     $void->content( 'action' => 'void', %content );
3946     $void->submit();
3947     if ( $void->is_success ) {
3948       my $error = $cust_pay->void($options{'reason'});
3949       if ( $error ) {
3950         # gah, even with transactions.
3951         my $e = 'WARNING: Card/ACH voided but database not updated - '.
3952                 "error voiding payment: $error";
3953         warn $e;
3954         return $e;
3955       }
3956       warn "  void successful\n" if $DEBUG > 1;
3957       return '';
3958     }
3959   }
3960
3961   warn "  void unsuccessful, trying refund\n"
3962     if $DEBUG > 1;
3963
3964   #massage data
3965   my $address = $self->address1;
3966   $address .= ", ". $self->address2 if $self->address2;
3967
3968   my($payname, $payfirst, $paylast);
3969   if ( $self->payname && $method ne 'ECHECK' ) {
3970     $payname = $self->payname;
3971     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
3972       or return "Illegal payname $payname";
3973     ($payfirst, $paylast) = ($1, $2);
3974   } else {
3975     $payfirst = $self->getfield('first');
3976     $paylast = $self->getfield('last');
3977     $payname =  "$payfirst $paylast";
3978   }
3979
3980   my @invoicing_list = $self->invoicing_list_emailonly;
3981   if ( $conf->exists('emailinvoiceautoalways')
3982        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
3983        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
3984     push @invoicing_list, $self->all_emails;
3985   }
3986
3987   my $email = ($conf->exists('business-onlinepayment-email-override'))
3988               ? $conf->config('business-onlinepayment-email-override')
3989               : $invoicing_list[0];
3990
3991   my $payip = exists($options{'payip'})
3992                 ? $options{'payip'}
3993                 : $self->payip;
3994   $content{customer_ip} = $payip
3995     if length($payip);
3996
3997   my $payinfo = '';
3998   if ( $method eq 'CC' ) {
3999
4000     if ( $cust_pay ) {
4001       $content{card_number} = $payinfo = $cust_pay->payinfo;
4002       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
4003         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
4004         ($content{expiration} = "$2/$1");  # where available
4005     } else {
4006       $content{card_number} = $payinfo = $self->payinfo;
4007       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
4008         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4009       $content{expiration} = "$2/$1";
4010     }
4011
4012   } elsif ( $method eq 'ECHECK' ) {
4013
4014     if ( $cust_pay ) {
4015       $payinfo = $cust_pay->payinfo;
4016     } else {
4017       $payinfo = $self->payinfo;
4018     }
4019     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
4020     $content{bank_name} = $self->payname;
4021     $content{account_type} = 'CHECKING';
4022     $content{account_name} = $payname;
4023     $content{customer_org} = $self->company ? 'B' : 'I';
4024     $content{customer_ssn} = $self->ss;
4025   } elsif ( $method eq 'LEC' ) {
4026     $content{phone} = $payinfo = $self->payinfo;
4027   }
4028
4029   #then try refund
4030   my $refund = new Business::OnlinePayment( $processor, @bop_options );
4031   my %sub_content = $refund->content(
4032     'action'         => 'credit',
4033     'customer_id'    => $self->custnum,
4034     'last_name'      => $paylast,
4035     'first_name'     => $payfirst,
4036     'name'           => $payname,
4037     'address'        => $address,
4038     'city'           => $self->city,
4039     'state'          => $self->state,
4040     'zip'            => $self->zip,
4041     'country'        => $self->country,
4042     'email'          => $email,
4043     'phone'          => $self->daytime || $self->night,
4044     %content, #after
4045   );
4046   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
4047     if $DEBUG > 1;
4048   $refund->submit();
4049
4050   return "$processor error: ". $refund->error_message
4051     unless $refund->is_success();
4052
4053   my %method2payby = (
4054     'CC'     => 'CARD',
4055     'ECHECK' => 'CHEK',
4056     'LEC'    => 'LECB',
4057   );
4058
4059   my $paybatch = "$processor:". $refund->authorization;
4060   $paybatch .= ':'. $refund->order_number
4061     if $refund->can('order_number') && $refund->order_number;
4062
4063   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
4064     my @cust_bill_pay = $cust_pay->cust_bill_pay;
4065     last unless @cust_bill_pay;
4066     my $cust_bill_pay = pop @cust_bill_pay;
4067     my $error = $cust_bill_pay->delete;
4068     last if $error;
4069   }
4070
4071   my $cust_refund = new FS::cust_refund ( {
4072     'custnum'  => $self->custnum,
4073     'paynum'   => $options{'paynum'},
4074     'refund'   => $amount,
4075     '_date'    => '',
4076     'payby'    => $method2payby{$method},
4077     'payinfo'  => $payinfo,
4078     'paybatch' => $paybatch,
4079     'reason'   => $options{'reason'} || 'card or ACH refund',
4080   } );
4081   my $error = $cust_refund->insert;
4082   if ( $error ) {
4083     $cust_refund->paynum(''); #try again with no specific paynum
4084     my $error2 = $cust_refund->insert;
4085     if ( $error2 ) {
4086       # gah, even with transactions.
4087       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
4088               "error inserting refund ($processor): $error2".
4089               " (previously tried insert with paynum #$options{'paynum'}" .
4090               ": $error )";
4091       warn $e;
4092       return $e;
4093     }
4094   }
4095
4096   ''; #no error
4097
4098 }
4099
4100 =item batch_card OPTION => VALUE...
4101
4102 Adds a payment for this invoice to the pending credit card batch (see
4103 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
4104 runs the payment using a realtime gateway.
4105
4106 =cut
4107
4108 sub batch_card {
4109   my ($self, %options) = @_;
4110
4111   my $amount;
4112   if (exists($options{amount})) {
4113     $amount = $options{amount};
4114   }else{
4115     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
4116   }
4117   return '' unless $amount > 0;
4118
4119   my $invnum = delete $options{invnum};
4120   my $payby = $options{invnum} || $self->payby;  #dubious
4121
4122   if ($options{'realtime'}) {
4123     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
4124                                 $amount,
4125                                 %options,
4126                               );
4127   }
4128
4129   my $oldAutoCommit = $FS::UID::AutoCommit;
4130   local $FS::UID::AutoCommit = 0;
4131   my $dbh = dbh;
4132
4133   #this needs to handle mysql as well as Pg, like svc_acct.pm
4134   #(make it into a common function if folks need to do batching with mysql)
4135   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
4136     or return "Cannot lock pay_batch: " . $dbh->errstr;
4137
4138   my %pay_batch = (
4139     'status' => 'O',
4140     'payby'  => FS::payby->payby2payment($payby),
4141   );
4142
4143   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
4144
4145   unless ( $pay_batch ) {
4146     $pay_batch = new FS::pay_batch \%pay_batch;
4147     my $error = $pay_batch->insert;
4148     if ( $error ) {
4149       $dbh->rollback if $oldAutoCommit;
4150       die "error creating new batch: $error\n";
4151     }
4152   }
4153
4154   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
4155       'batchnum' => $pay_batch->batchnum,
4156       'custnum'  => $self->custnum,
4157   } );
4158
4159   foreach (qw( address1 address2 city state zip country payby payinfo paydate
4160                payname )) {
4161     $options{$_} = '' unless exists($options{$_});
4162   }
4163
4164   my $cust_pay_batch = new FS::cust_pay_batch ( {
4165     'batchnum' => $pay_batch->batchnum,
4166     'invnum'   => $invnum || 0,                    # is there a better value?
4167                                                    # this field should be
4168                                                    # removed...
4169                                                    # cust_bill_pay_batch now
4170     'custnum'  => $self->custnum,
4171     'last'     => $self->getfield('last'),
4172     'first'    => $self->getfield('first'),
4173     'address1' => $options{address1} || $self->address1,
4174     'address2' => $options{address2} || $self->address2,
4175     'city'     => $options{city}     || $self->city,
4176     'state'    => $options{state}    || $self->state,
4177     'zip'      => $options{zip}      || $self->zip,
4178     'country'  => $options{country}  || $self->country,
4179     'payby'    => $options{payby}    || $self->payby,
4180     'payinfo'  => $options{payinfo}  || $self->payinfo,
4181     'exp'      => $options{paydate}  || $self->paydate,
4182     'payname'  => $options{payname}  || $self->payname,
4183     'amount'   => $amount,                         # consolidating
4184   } );
4185
4186   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
4187     if $old_cust_pay_batch;
4188
4189   my $error;
4190   if ($old_cust_pay_batch) {
4191     $error = $cust_pay_batch->replace($old_cust_pay_batch)
4192   } else {
4193     $error = $cust_pay_batch->insert;
4194   }
4195
4196   if ( $error ) {
4197     $dbh->rollback if $oldAutoCommit;
4198     die $error;
4199   }
4200
4201   my $unapplied = $self->total_credited + $self->total_unapplied_payments + $self->in_transit_payments;
4202   foreach my $cust_bill ($self->open_cust_bill) {
4203     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
4204     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
4205       'invnum' => $cust_bill->invnum,
4206       'paybatchnum' => $cust_pay_batch->paybatchnum,
4207       'amount' => $cust_bill->owed,
4208       '_date' => time,
4209     };
4210     if ($unapplied >= $cust_bill_pay_batch->amount){
4211       $unapplied -= $cust_bill_pay_batch->amount;
4212       next;
4213     }else{
4214       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
4215                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
4216     }
4217     $error = $cust_bill_pay_batch->insert;
4218     if ( $error ) {
4219       $dbh->rollback if $oldAutoCommit;
4220       die $error;
4221     }
4222   }
4223
4224   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4225   '';
4226 }
4227
4228 =item total_owed
4229
4230 Returns the total owed for this customer on all invoices
4231 (see L<FS::cust_bill/owed>).
4232
4233 =cut
4234
4235 sub total_owed {
4236   my $self = shift;
4237   $self->total_owed_date(2145859200); #12/31/2037
4238 }
4239
4240 =item total_owed_date TIME
4241
4242 Returns the total owed for this customer on all invoices with date earlier than
4243 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
4244 see L<Time::Local> and L<Date::Parse> for conversion functions.
4245
4246 =cut
4247
4248 sub total_owed_date {
4249   my $self = shift;
4250   my $time = shift;
4251   my $total_bill = 0;
4252   foreach my $cust_bill (
4253     grep { $_->_date <= $time }
4254       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4255   ) {
4256     $total_bill += $cust_bill->owed;
4257   }
4258   sprintf( "%.2f", $total_bill );
4259 }
4260
4261 =item apply_payments_and_credits
4262
4263 Applies unapplied payments and credits.
4264
4265 In most cases, this new method should be used in place of sequential
4266 apply_payments and apply_credits methods.
4267
4268 If there is an error, returns the error, otherwise returns false.
4269
4270 =cut
4271
4272 sub apply_payments_and_credits {
4273   my $self = shift;
4274
4275   local $SIG{HUP} = 'IGNORE';
4276   local $SIG{INT} = 'IGNORE';
4277   local $SIG{QUIT} = 'IGNORE';
4278   local $SIG{TERM} = 'IGNORE';
4279   local $SIG{TSTP} = 'IGNORE';
4280   local $SIG{PIPE} = 'IGNORE';
4281
4282   my $oldAutoCommit = $FS::UID::AutoCommit;
4283   local $FS::UID::AutoCommit = 0;
4284   my $dbh = dbh;
4285
4286   $self->select_for_update; #mutex
4287
4288   foreach my $cust_bill ( $self->open_cust_bill ) {
4289     my $error = $cust_bill->apply_payments_and_credits;
4290     if ( $error ) {
4291       $dbh->rollback if $oldAutoCommit;
4292       return "Error applying: $error";
4293     }
4294   }
4295
4296   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4297   ''; #no error
4298
4299 }
4300
4301 =item apply_credits OPTION => VALUE ...
4302
4303 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
4304 to outstanding invoice balances in chronological order (or reverse
4305 chronological order if the I<order> option is set to B<newest>) and returns the
4306 value of any remaining unapplied credits available for refund (see
4307 L<FS::cust_refund>).
4308
4309 Dies if there is an error.
4310
4311 =cut
4312
4313 sub apply_credits {
4314   my $self = shift;
4315   my %opt = @_;
4316
4317   local $SIG{HUP} = 'IGNORE';
4318   local $SIG{INT} = 'IGNORE';
4319   local $SIG{QUIT} = 'IGNORE';
4320   local $SIG{TERM} = 'IGNORE';
4321   local $SIG{TSTP} = 'IGNORE';
4322   local $SIG{PIPE} = 'IGNORE';
4323
4324   my $oldAutoCommit = $FS::UID::AutoCommit;
4325   local $FS::UID::AutoCommit = 0;
4326   my $dbh = dbh;
4327
4328   $self->select_for_update; #mutex
4329
4330   unless ( $self->total_credited ) {
4331     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4332     return 0;
4333   }
4334
4335   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
4336       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
4337
4338   my @invoices = $self->open_cust_bill;
4339   @invoices = sort { $b->_date <=> $a->_date } @invoices
4340     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
4341
4342   my $credit;
4343   foreach my $cust_bill ( @invoices ) {
4344     my $amount;
4345
4346     if ( !defined($credit) || $credit->credited == 0) {
4347       $credit = pop @credits or last;
4348     }
4349
4350     if ($cust_bill->owed >= $credit->credited) {
4351       $amount=$credit->credited;
4352     }else{
4353       $amount=$cust_bill->owed;
4354     }
4355
4356     my $cust_credit_bill = new FS::cust_credit_bill ( {
4357       'crednum' => $credit->crednum,
4358       'invnum'  => $cust_bill->invnum,
4359       'amount'  => $amount,
4360     } );
4361     my $error = $cust_credit_bill->insert;
4362     if ( $error ) {
4363       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4364       die $error;
4365     }
4366
4367     redo if ($cust_bill->owed > 0);
4368
4369   }
4370
4371   my $total_credited = $self->total_credited;
4372
4373   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4374
4375   return $total_credited;
4376 }
4377
4378 =item apply_payments
4379
4380 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
4381 to outstanding invoice balances in chronological order.
4382
4383  #and returns the value of any remaining unapplied payments.
4384
4385 Dies if there is an error.
4386
4387 =cut
4388
4389 sub apply_payments {
4390   my $self = shift;
4391
4392   local $SIG{HUP} = 'IGNORE';
4393   local $SIG{INT} = 'IGNORE';
4394   local $SIG{QUIT} = 'IGNORE';
4395   local $SIG{TERM} = 'IGNORE';
4396   local $SIG{TSTP} = 'IGNORE';
4397   local $SIG{PIPE} = 'IGNORE';
4398
4399   my $oldAutoCommit = $FS::UID::AutoCommit;
4400   local $FS::UID::AutoCommit = 0;
4401   my $dbh = dbh;
4402
4403   $self->select_for_update; #mutex
4404
4405   #return 0 unless
4406
4407   my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 }
4408       qsearch('cust_pay', { 'custnum' => $self->custnum } ) );
4409
4410   my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 }
4411       qsearch('cust_bill', { 'custnum' => $self->custnum } ) );
4412
4413   my $payment;
4414
4415   foreach my $cust_bill ( @invoices ) {
4416     my $amount;
4417
4418     if ( !defined($payment) || $payment->unapplied == 0 ) {
4419       $payment = pop @payments or last;
4420     }
4421
4422     if ( $cust_bill->owed >= $payment->unapplied ) {
4423       $amount = $payment->unapplied;
4424     } else {
4425       $amount = $cust_bill->owed;
4426     }
4427
4428     my $cust_bill_pay = new FS::cust_bill_pay ( {
4429       'paynum' => $payment->paynum,
4430       'invnum' => $cust_bill->invnum,
4431       'amount' => $amount,
4432     } );
4433     my $error = $cust_bill_pay->insert;
4434     if ( $error ) {
4435       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
4436       die $error;
4437     }
4438
4439     redo if ( $cust_bill->owed > 0);
4440
4441   }
4442
4443   my $total_unapplied_payments = $self->total_unapplied_payments;
4444
4445   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4446
4447   return $total_unapplied_payments;
4448 }
4449
4450 =item total_credited
4451
4452 Returns the total outstanding credit (see L<FS::cust_credit>) for this
4453 customer.  See L<FS::cust_credit/credited>.
4454
4455 =cut
4456
4457 sub total_credited {
4458   my $self = shift;
4459   my $total_credit = 0;
4460   foreach my $cust_credit ( qsearch('cust_credit', {
4461     'custnum' => $self->custnum,
4462   } ) ) {
4463     $total_credit += $cust_credit->credited;
4464   }
4465   sprintf( "%.2f", $total_credit );
4466 }
4467
4468 =item total_unapplied_payments
4469
4470 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
4471 See L<FS::cust_pay/unapplied>.
4472
4473 =cut
4474
4475 sub total_unapplied_payments {
4476   my $self = shift;
4477   my $total_unapplied = 0;
4478   foreach my $cust_pay ( qsearch('cust_pay', {
4479     'custnum' => $self->custnum,
4480   } ) ) {
4481     $total_unapplied += $cust_pay->unapplied;
4482   }
4483   sprintf( "%.2f", $total_unapplied );
4484 }
4485
4486 =item total_unapplied_refunds
4487
4488 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
4489 customer.  See L<FS::cust_refund/unapplied>.
4490
4491 =cut
4492
4493 sub total_unapplied_refunds {
4494   my $self = shift;
4495   my $total_unapplied = 0;
4496   foreach my $cust_refund ( qsearch('cust_refund', {
4497     'custnum' => $self->custnum,
4498   } ) ) {
4499     $total_unapplied += $cust_refund->unapplied;
4500   }
4501   sprintf( "%.2f", $total_unapplied );
4502 }
4503
4504 =item balance
4505
4506 Returns the balance for this customer (total_owed plus total_unrefunded, minus
4507 total_credited minus total_unapplied_payments).
4508
4509 =cut
4510
4511 sub balance {
4512   my $self = shift;
4513   sprintf( "%.2f",
4514       $self->total_owed
4515     + $self->total_unapplied_refunds
4516     - $self->total_credited
4517     - $self->total_unapplied_payments
4518   );
4519 }
4520
4521 =item balance_date TIME
4522
4523 Returns the balance for this customer, only considering invoices with date
4524 earlier than TIME (total_owed_date minus total_credited minus
4525 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
4526 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
4527 functions.
4528
4529 =cut
4530
4531 sub balance_date {
4532   my $self = shift;
4533   my $time = shift;
4534   sprintf( "%.2f",
4535         $self->total_owed_date($time)
4536       + $self->total_unapplied_refunds
4537       - $self->total_credited
4538       - $self->total_unapplied_payments
4539   );
4540 }
4541
4542 =item in_transit_payments
4543
4544 Returns the total of requests for payments for this customer pending in
4545 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
4546
4547 =cut
4548
4549 sub in_transit_payments {
4550   my $self = shift;
4551   my $in_transit_payments = 0;
4552   foreach my $pay_batch ( qsearch('pay_batch', {
4553     'status' => 'I',
4554   } ) ) {
4555     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
4556       'batchnum' => $pay_batch->batchnum,
4557       'custnum' => $self->custnum,
4558     } ) ) {
4559       $in_transit_payments += $cust_pay_batch->amount;
4560     }
4561   }
4562   sprintf( "%.2f", $in_transit_payments );
4563 }
4564
4565 =item paydate_monthyear
4566
4567 Returns a two-element list consisting of the month and year of this customer's
4568 paydate (credit card expiration date for CARD customers)
4569
4570 =cut
4571
4572 sub paydate_monthyear {
4573   my $self = shift;
4574   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
4575     ( $2, $1 );
4576   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
4577     ( $1, $3 );
4578   } else {
4579     ('', '');
4580   }
4581 }
4582
4583 =item invoicing_list [ ARRAYREF ]
4584
4585 If an arguement is given, sets these email addresses as invoice recipients
4586 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
4587 (except as warnings), so use check_invoicing_list first.
4588
4589 Returns a list of email addresses (with svcnum entries expanded).
4590
4591 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
4592 check it without disturbing anything by passing nothing.
4593
4594 This interface may change in the future.
4595
4596 =cut
4597
4598 sub invoicing_list {
4599   my( $self, $arrayref ) = @_;
4600
4601   if ( $arrayref ) {
4602     my @cust_main_invoice;
4603     if ( $self->custnum ) {
4604       @cust_main_invoice =
4605         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4606     } else {
4607       @cust_main_invoice = ();
4608     }
4609     foreach my $cust_main_invoice ( @cust_main_invoice ) {
4610       #warn $cust_main_invoice->destnum;
4611       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
4612         #warn $cust_main_invoice->destnum;
4613         my $error = $cust_main_invoice->delete;
4614         warn $error if $error;
4615       }
4616     }
4617     if ( $self->custnum ) {
4618       @cust_main_invoice =
4619         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4620     } else {
4621       @cust_main_invoice = ();
4622     }
4623     my %seen = map { $_->address => 1 } @cust_main_invoice;
4624     foreach my $address ( @{$arrayref} ) {
4625       next if exists $seen{$address} && $seen{$address};
4626       $seen{$address} = 1;
4627       my $cust_main_invoice = new FS::cust_main_invoice ( {
4628         'custnum' => $self->custnum,
4629         'dest'    => $address,
4630       } );
4631       my $error = $cust_main_invoice->insert;
4632       warn $error if $error;
4633     }
4634   }
4635
4636   if ( $self->custnum ) {
4637     map { $_->address }
4638       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
4639   } else {
4640     ();
4641   }
4642
4643 }
4644
4645 =item check_invoicing_list ARRAYREF
4646
4647 Checks these arguements as valid input for the invoicing_list method.  If there
4648 is an error, returns the error, otherwise returns false.
4649
4650 =cut
4651
4652 sub check_invoicing_list {
4653   my( $self, $arrayref ) = @_;
4654
4655   foreach my $address ( @$arrayref ) {
4656
4657     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
4658       return 'Can\'t add FAX invoice destination with a blank FAX number.';
4659     }
4660
4661     my $cust_main_invoice = new FS::cust_main_invoice ( {
4662       'custnum' => $self->custnum,
4663       'dest'    => $address,
4664     } );
4665     my $error = $self->custnum
4666                 ? $cust_main_invoice->check
4667                 : $cust_main_invoice->checkdest
4668     ;
4669     return $error if $error;
4670
4671   }
4672
4673   return "Email address required"
4674     if $conf->exists('cust_main-require_invoicing_list_email')
4675     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
4676
4677   '';
4678 }
4679
4680 =item set_default_invoicing_list
4681
4682 Sets the invoicing list to all accounts associated with this customer,
4683 overwriting any previous invoicing list.
4684
4685 =cut
4686
4687 sub set_default_invoicing_list {
4688   my $self = shift;
4689   $self->invoicing_list($self->all_emails);
4690 }
4691
4692 =item all_emails
4693
4694 Returns the email addresses of all accounts provisioned for this customer.
4695
4696 =cut
4697
4698 sub all_emails {
4699   my $self = shift;
4700   my %list;
4701   foreach my $cust_pkg ( $self->all_pkgs ) {
4702     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
4703     my @svc_acct =
4704       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4705         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
4706           @cust_svc;
4707     $list{$_}=1 foreach map { $_->email } @svc_acct;
4708   }
4709   keys %list;
4710 }
4711
4712 =item invoicing_list_addpost
4713
4714 Adds postal invoicing to this customer.  If this customer is already configured
4715 to receive postal invoices, does nothing.
4716
4717 =cut
4718
4719 sub invoicing_list_addpost {
4720   my $self = shift;
4721   return if grep { $_ eq 'POST' } $self->invoicing_list;
4722   my @invoicing_list = $self->invoicing_list;
4723   push @invoicing_list, 'POST';
4724   $self->invoicing_list(\@invoicing_list);
4725 }
4726
4727 =item invoicing_list_emailonly
4728
4729 Returns the list of email invoice recipients (invoicing_list without non-email
4730 destinations such as POST and FAX).
4731
4732 =cut
4733
4734 sub invoicing_list_emailonly {
4735   my $self = shift;
4736   warn "$me invoicing_list_emailonly called"
4737     if $DEBUG;
4738   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
4739 }
4740
4741 =item invoicing_list_emailonly_scalar
4742
4743 Returns the list of email invoice recipients (invoicing_list without non-email
4744 destinations such as POST and FAX) as a comma-separated scalar.
4745
4746 =cut
4747
4748 sub invoicing_list_emailonly_scalar {
4749   my $self = shift;
4750   warn "$me invoicing_list_emailonly_scalar called"
4751     if $DEBUG;
4752   join(', ', $self->invoicing_list_emailonly);
4753 }
4754
4755 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
4756
4757 Returns an array of customers referred by this customer (referral_custnum set
4758 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
4759 customers referred by customers referred by this customer and so on, inclusive.
4760 The default behavior is DEPTH 1 (no recursion).
4761
4762 =cut
4763
4764 sub referral_cust_main {
4765   my $self = shift;
4766   my $depth = @_ ? shift : 1;
4767   my $exclude = @_ ? shift : {};
4768
4769   my @cust_main =
4770     map { $exclude->{$_->custnum}++; $_; }
4771       grep { ! $exclude->{ $_->custnum } }
4772         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
4773
4774   if ( $depth > 1 ) {
4775     push @cust_main,
4776       map { $_->referral_cust_main($depth-1, $exclude) }
4777         @cust_main;
4778   }
4779
4780   @cust_main;
4781 }
4782
4783 =item referral_cust_main_ncancelled
4784
4785 Same as referral_cust_main, except only returns customers with uncancelled
4786 packages.
4787
4788 =cut
4789
4790 sub referral_cust_main_ncancelled {
4791   my $self = shift;
4792   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
4793 }
4794
4795 =item referral_cust_pkg [ DEPTH ]
4796
4797 Like referral_cust_main, except returns a flat list of all unsuspended (and
4798 uncancelled) packages for each customer.  The number of items in this list may
4799 be useful for comission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
4800
4801 =cut
4802
4803 sub referral_cust_pkg {
4804   my $self = shift;
4805   my $depth = @_ ? shift : 1;
4806
4807   map { $_->unsuspended_pkgs }
4808     grep { $_->unsuspended_pkgs }
4809       $self->referral_cust_main($depth);
4810 }
4811
4812 =item referring_cust_main
4813
4814 Returns the single cust_main record for the customer who referred this customer
4815 (referral_custnum), or false.
4816
4817 =cut
4818
4819 sub referring_cust_main {
4820   my $self = shift;
4821   return '' unless $self->referral_custnum;
4822   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
4823 }
4824
4825 =item credit AMOUNT, REASON
4826
4827 Applies a credit to this customer.  If there is an error, returns the error,
4828 otherwise returns false.
4829
4830 =cut
4831
4832 sub credit {
4833   my( $self, $amount, $reason, %options ) = @_;
4834   my $cust_credit = new FS::cust_credit {
4835     'custnum' => $self->custnum,
4836     'amount'  => $amount,
4837     'reason'  => $reason,
4838   };
4839   $cust_credit->insert(%options);
4840 }
4841
4842 =item charge AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
4843
4844 Creates a one-time charge for this customer.  If there is an error, returns
4845 the error, otherwise returns false.
4846
4847 =cut
4848
4849 sub charge {
4850   my $self = shift;
4851   my ( $amount, $quantity, $pkg, $comment, $taxclass, $additional, $classnum );
4852   my ( $taxproduct, $override );
4853   if ( ref( $_[0] ) ) {
4854     $amount     = $_[0]->{amount};
4855     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
4856     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
4857     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
4858                                            : '$'. sprintf("%.2f",$amount);
4859     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
4860     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
4861     $additional = $_[0]->{additional};
4862     $taxproduct = $_[0]->{taxproductnum};
4863     $override   = { '' => $_[0]->{tax_override} };
4864   }else{
4865     $amount     = shift;
4866     $quantity   = 1;
4867     $pkg        = @_ ? shift : 'One-time charge';
4868     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
4869     $taxclass   = @_ ? shift : '';
4870     $additional = [];
4871   }
4872
4873   local $SIG{HUP} = 'IGNORE';
4874   local $SIG{INT} = 'IGNORE';
4875   local $SIG{QUIT} = 'IGNORE';
4876   local $SIG{TERM} = 'IGNORE';
4877   local $SIG{TSTP} = 'IGNORE';
4878   local $SIG{PIPE} = 'IGNORE';
4879
4880   my $oldAutoCommit = $FS::UID::AutoCommit;
4881   local $FS::UID::AutoCommit = 0;
4882   my $dbh = dbh;
4883
4884   my $part_pkg = new FS::part_pkg ( {
4885     'pkg'           => $pkg,
4886     'comment'       => $comment,
4887     'plan'          => 'flat',
4888     'freq'          => 0,
4889     'disabled'      => 'Y',
4890     'classnum'      => $classnum ? $classnum : '',
4891     'taxclass'      => $taxclass,
4892     'taxproductnum' => $taxproduct,
4893   } );
4894
4895   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
4896                         ( 0 .. @$additional - 1 )
4897                   ),
4898                   'additional_count' => scalar(@$additional),
4899                   'setup_fee' => $amount,
4900                 );
4901
4902   my $error = $part_pkg->insert( options       => \%options,
4903                                  tax_overrides => $override,
4904                                );
4905   if ( $error ) {
4906     $dbh->rollback if $oldAutoCommit;
4907     return $error;
4908   }
4909
4910   my $pkgpart = $part_pkg->pkgpart;
4911   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
4912   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
4913     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
4914     $error = $type_pkgs->insert;
4915     if ( $error ) {
4916       $dbh->rollback if $oldAutoCommit;
4917       return $error;
4918     }
4919   }
4920
4921   my $cust_pkg = new FS::cust_pkg ( {
4922     'custnum'  => $self->custnum,
4923     'pkgpart'  => $pkgpart,
4924     'quantity' => $quantity,
4925   } );
4926
4927   $error = $cust_pkg->insert;
4928   if ( $error ) {
4929     $dbh->rollback if $oldAutoCommit;
4930     return $error;
4931   }
4932
4933   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4934   '';
4935
4936 }
4937
4938 #=item charge_postal_fee
4939 #
4940 #Applies a one time charge this customer.  If there is an error,
4941 #returns the error, returns the cust_pkg charge object or false
4942 #if there was no charge.
4943 #
4944 #=cut
4945 #
4946 # This should be a customer event.  For that to work requires that bill
4947 # also be a customer event.
4948
4949 sub charge_postal_fee {
4950   my $self = shift;
4951
4952   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
4953   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
4954
4955   my $cust_pkg = new FS::cust_pkg ( {
4956     'custnum'  => $self->custnum,
4957     'pkgpart'  => $pkgpart,
4958     'quantity' => 1,
4959   } );
4960
4961   my $error = $cust_pkg->insert;
4962   $error ? $error : $cust_pkg;
4963 }
4964
4965 =item cust_bill
4966
4967 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4968
4969 =cut
4970
4971 sub cust_bill {
4972   my $self = shift;
4973   sort { $a->_date <=> $b->_date }
4974     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4975 }
4976
4977 =item open_cust_bill
4978
4979 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4980 customer.
4981
4982 =cut
4983
4984 sub open_cust_bill {
4985   my $self = shift;
4986   grep { $_->owed > 0 } $self->cust_bill;
4987 }
4988
4989 =item cust_credit
4990
4991 Returns all the credits (see L<FS::cust_credit>) for this customer.
4992
4993 =cut
4994
4995 sub cust_credit {
4996   my $self = shift;
4997   sort { $a->_date <=> $b->_date }
4998     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
4999 }
5000
5001 =item cust_pay
5002
5003 Returns all the payments (see L<FS::cust_pay>) for this customer.
5004
5005 =cut
5006
5007 sub cust_pay {
5008   my $self = shift;
5009   sort { $a->_date <=> $b->_date }
5010     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
5011 }
5012
5013 =item cust_pay_void
5014
5015 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
5016
5017 =cut
5018
5019 sub cust_pay_void {
5020   my $self = shift;
5021   sort { $a->_date <=> $b->_date }
5022     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
5023 }
5024
5025 =item cust_pay_batch
5026
5027 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
5028
5029 =cut
5030
5031 sub cust_pay_batch {
5032   my $self = shift;
5033   sort { $a->_date <=> $b->_date }
5034     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
5035 }
5036
5037 =item cust_refund
5038
5039 Returns all the refunds (see L<FS::cust_refund>) for this customer.
5040
5041 =cut
5042
5043 sub cust_refund {
5044   my $self = shift;
5045   sort { $a->_date <=> $b->_date }
5046     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
5047 }
5048
5049 =item name
5050
5051 Returns a name string for this customer, either "Company (Last, First)" or
5052 "Last, First".
5053
5054 =cut
5055
5056 sub name {
5057   my $self = shift;
5058   my $name = $self->contact;
5059   $name = $self->company. " ($name)" if $self->company;
5060   $name;
5061 }
5062
5063 =item ship_name
5064
5065 Returns a name string for this (service/shipping) contact, either
5066 "Company (Last, First)" or "Last, First".
5067
5068 =cut
5069
5070 sub ship_name {
5071   my $self = shift;
5072   if ( $self->get('ship_last') ) {
5073     my $name = $self->ship_contact;
5074     $name = $self->ship_company. " ($name)" if $self->ship_company;
5075     $name;
5076   } else {
5077     $self->name;
5078   }
5079 }
5080
5081 =item contact
5082
5083 Returns this customer's full (billing) contact name only, "Last, First"
5084
5085 =cut
5086
5087 sub contact {
5088   my $self = shift;
5089   $self->get('last'). ', '. $self->first;
5090 }
5091
5092 =item ship_contact
5093
5094 Returns this customer's full (shipping) contact name only, "Last, First"
5095
5096 =cut
5097
5098 sub ship_contact {
5099   my $self = shift;
5100   $self->get('ship_last')
5101     ? $self->get('ship_last'). ', '. $self->ship_first
5102     : $self->contact;
5103 }
5104
5105 =item country_full
5106
5107 Returns this customer's full country name
5108
5109 =cut
5110
5111 sub country_full {
5112   my $self = shift;
5113   code2country($self->country);
5114 }
5115
5116 =item geocode DATA_VENDOR
5117
5118 Returns a value for the customer location as encoded by DATA_VENDOR.
5119 Currently this only makes sense for "CCH" as DATA_VENDOR.
5120
5121 =cut
5122
5123 sub geocode {
5124   my ($self, $data_vendor) = (shift, shift);  #always cch for now
5125
5126   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
5127                ? 'ship_'
5128                : '';
5129
5130   my ($zip,$plus4) = split /-/, $self->get("${prefix}zip")
5131     if $self->country eq 'US';
5132
5133   #CCH specific location stuff
5134   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
5135
5136   my $geocode = '';
5137   my $cust_tax_location =
5138     qsearchs( {
5139                 'table'     => 'cust_tax_location',
5140                 'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
5141                 'extra_sql' => $extra_sql,
5142               }
5143             );
5144   $geocode = $cust_tax_location->geocode
5145     if $cust_tax_location;
5146
5147   $geocode;
5148 }
5149
5150 =item cust_status
5151
5152 =item status
5153
5154 Returns a status string for this customer, currently:
5155
5156 =over 4
5157
5158 =item prospect - No packages have ever been ordered
5159
5160 =item active - One or more recurring packages is active
5161
5162 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
5163
5164 =item suspended - All non-cancelled recurring packages are suspended
5165
5166 =item cancelled - All recurring packages are cancelled
5167
5168 =back
5169
5170 =cut
5171
5172 sub status { shift->cust_status(@_); }
5173
5174 sub cust_status {
5175   my $self = shift;
5176   for my $status (qw( prospect active inactive suspended cancelled )) {
5177     my $method = $status.'_sql';
5178     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
5179     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
5180     $sth->execute( ($self->custnum) x $numnum )
5181       or die "Error executing 'SELECT $sql': ". $sth->errstr;
5182     return $status if $sth->fetchrow_arrayref->[0];
5183   }
5184 }
5185
5186 =item ucfirst_cust_status
5187
5188 =item ucfirst_status
5189
5190 Returns the status with the first character capitalized.
5191
5192 =cut
5193
5194 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
5195
5196 sub ucfirst_cust_status {
5197   my $self = shift;
5198   ucfirst($self->cust_status);
5199 }
5200
5201 =item statuscolor
5202
5203 Returns a hex triplet color string for this customer's status.
5204
5205 =cut
5206
5207 use vars qw(%statuscolor);
5208 tie %statuscolor, 'Tie::IxHash',
5209   'prospect'  => '7e0079', #'000000', #black?  naw, purple
5210   'active'    => '00CC00', #green
5211   'inactive'  => '0000CC', #blue
5212   'suspended' => 'FF9900', #yellow
5213   'cancelled' => 'FF0000', #red
5214 ;
5215
5216 sub statuscolor { shift->cust_statuscolor(@_); }
5217
5218 sub cust_statuscolor {
5219   my $self = shift;
5220   $statuscolor{$self->cust_status};
5221 }
5222
5223 =item tickets
5224
5225 Returns an array of hashes representing the customer's RT tickets.
5226
5227 =cut
5228
5229 sub tickets {
5230   my $self = shift;
5231
5232   my $num = $conf->config('cust_main-max_tickets') || 10;
5233   my @tickets = ();
5234
5235   unless ( $conf->config('ticket_system-custom_priority_field') ) {
5236
5237     @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
5238
5239   } else {
5240
5241     foreach my $priority (
5242       $conf->config('ticket_system-custom_priority_field-values'), ''
5243     ) {
5244       last if scalar(@tickets) >= $num;
5245       push @tickets,
5246         @{ FS::TicketSystem->customer_tickets( $self->custnum,
5247                                                $num - scalar(@tickets),
5248                                                $priority,
5249                                              )
5250          };
5251     }
5252   }
5253   (@tickets);
5254 }
5255
5256 # Return services representing svc_accts in customer support packages
5257 sub support_services {
5258   my $self = shift;
5259   my %packages = map { $_ => 1 } $conf->config('support_packages');
5260
5261   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
5262     grep { $_->part_svc->svcdb eq 'svc_acct' }
5263     map { $_->cust_svc }
5264     grep { exists $packages{ $_->pkgpart } }
5265     $self->ncancelled_pkgs;
5266
5267 }
5268
5269 =back
5270
5271 =head1 CLASS METHODS
5272
5273 =over 4
5274
5275 =item statuses
5276
5277 Class method that returns the list of possible status strings for customers
5278 (see L<the status method|/status>).  For example:
5279
5280   @statuses = FS::cust_main->statuses();
5281
5282 =cut
5283
5284 sub statuses {
5285   #my $self = shift; #could be class...
5286   keys %statuscolor;
5287 }
5288
5289 =item prospect_sql
5290
5291 Returns an SQL expression identifying prospective cust_main records (customers
5292 with no packages ever ordered)
5293
5294 =cut
5295
5296 use vars qw($select_count_pkgs);
5297 $select_count_pkgs =
5298   "SELECT COUNT(*) FROM cust_pkg
5299     WHERE cust_pkg.custnum = cust_main.custnum";
5300
5301 sub select_count_pkgs_sql {
5302   $select_count_pkgs;
5303 }
5304
5305 sub prospect_sql { "
5306   0 = ( $select_count_pkgs )
5307 "; }
5308
5309 =item active_sql
5310
5311 Returns an SQL expression identifying active cust_main records (customers with
5312 active recurring packages).
5313
5314 =cut
5315
5316 sub active_sql { "
5317   0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. "
5318       )
5319 "; }
5320
5321 =item inactive_sql
5322
5323 Returns an SQL expression identifying inactive cust_main records (customers with
5324 no active recurring packages, but otherwise unsuspended/uncancelled).
5325
5326 =cut
5327
5328 sub inactive_sql { "
5329   0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5330   AND
5331   0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5332 "; }
5333
5334 =item susp_sql
5335 =item suspended_sql
5336
5337 Returns an SQL expression identifying suspended cust_main records.
5338
5339 =cut
5340
5341
5342 sub suspended_sql { susp_sql(@_); }
5343 sub susp_sql { "
5344     0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " )
5345     AND
5346     0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " )
5347 "; }
5348
5349 =item cancel_sql
5350 =item cancelled_sql
5351
5352 Returns an SQL expression identifying cancelled cust_main records.
5353
5354 =cut
5355
5356 sub cancelled_sql { cancel_sql(@_); }
5357 sub cancel_sql {
5358
5359   my $recurring_sql = FS::cust_pkg->recurring_sql;
5360   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
5361
5362   "
5363         0 < ( $select_count_pkgs )
5364     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
5365     AND 0 = ( $select_count_pkgs AND $recurring_sql
5366                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
5367             )
5368     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
5369   ";
5370
5371 }
5372
5373 =item uncancel_sql
5374 =item uncancelled_sql
5375
5376 Returns an SQL expression identifying un-cancelled cust_main records.
5377
5378 =cut
5379
5380 sub uncancelled_sql { uncancel_sql(@_); }
5381 sub uncancel_sql { "
5382   ( 0 < ( $select_count_pkgs
5383                    AND ( cust_pkg.cancel IS NULL
5384                          OR cust_pkg.cancel = 0
5385                        )
5386         )
5387     OR 0 = ( $select_count_pkgs )
5388   )
5389 "; }
5390
5391 =item balance_sql
5392
5393 Returns an SQL fragment to retreive the balance.
5394
5395 =cut
5396
5397 sub balance_sql { "
5398     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
5399         WHERE cust_bill.custnum   = cust_main.custnum     )
5400   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
5401         WHERE cust_pay.custnum    = cust_main.custnum     )
5402   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
5403         WHERE cust_credit.custnum = cust_main.custnum     )
5404   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
5405         WHERE cust_refund.custnum = cust_main.custnum     )
5406 "; }
5407
5408 =item balance_date_sql START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5409
5410 Returns an SQL fragment to retreive the balance for this customer, only
5411 considering invoices with date earlier than START_TIME, and optionally not
5412 later than END_TIME (total_owed_date minus total_credited minus
5413 total_unapplied_payments).
5414
5415 Times are specified as SQL fragments or numeric
5416 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
5417 L<Date::Parse> for conversion functions.  The empty string can be passed
5418 to disable that time constraint completely.
5419
5420 Available options are:
5421
5422 =over 4
5423
5424 =item unapplied_date
5425
5426 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)
5427
5428 =item total
5429
5430 (unused.  obsolete?)
5431 set to true to remove all customer comparison clauses, for totals
5432
5433 =item where
5434
5435 (unused.  obsolete?)
5436 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
5437
5438 =item join
5439
5440 (unused.  obsolete?)
5441 JOIN clause (typically used with the total option)
5442
5443 =back
5444
5445 =cut
5446
5447 sub balance_date_sql {
5448   my( $class, $start, $end, %opt ) = @_;
5449
5450   my $owed         = FS::cust_bill->owed_sql;
5451   my $unapp_refund = FS::cust_refund->unapplied_sql;
5452   my $unapp_credit = FS::cust_credit->unapplied_sql;
5453   my $unapp_pay    = FS::cust_pay->unapplied_sql;
5454
5455   my $j = $opt{'join'} || '';
5456
5457   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
5458   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
5459   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
5460   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
5461
5462   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
5463     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
5464     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
5465     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
5466   ";
5467
5468 }
5469
5470 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
5471
5472 Helper method for balance_date_sql; name (and usage) subject to change
5473 (suggestions welcome).
5474
5475 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5476 cust_refund, cust_credit or cust_pay).
5477
5478 If TABLE is "cust_bill" or the unapplied_date option is true, only
5479 considers records with date earlier than START_TIME, and optionally not
5480 later than END_TIME .
5481
5482 =cut
5483
5484 sub _money_table_where {
5485   my( $class, $table, $start, $end, %opt ) = @_;
5486
5487   my @where = ();
5488   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5489   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5490     push @where, "$table._date <= $start" if defined($start) && length($start);
5491     push @where, "$table._date >  $end"   if defined($end)   && length($end);
5492   }
5493   push @where, @{$opt{'where'}} if $opt{'where'};
5494   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5495
5496   $where;
5497
5498 }
5499
5500 =item search_sql HASHREF
5501
5502 (Class method)
5503
5504 Returns a qsearch hash expression to search for parameters specified in HREF.
5505 Valid parameters are
5506
5507 =over 4
5508
5509 =item agentnum
5510
5511 =item status
5512
5513 =item cancelled_pkgs
5514
5515 bool
5516
5517 =item signupdate
5518
5519 listref of start date, end date
5520
5521 =item payby
5522
5523 listref
5524
5525 =item current_balance
5526
5527 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
5528
5529 =item cust_fields
5530
5531 =item flattened_pkgs
5532
5533 bool
5534
5535 =back
5536
5537 =cut
5538
5539 sub search_sql {
5540   my ($class, $params) = @_;
5541
5542   my $dbh = dbh;
5543
5544   my @where = ();
5545   my $orderby;
5546
5547   ##
5548   # parse agent
5549   ##
5550
5551   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
5552     push @where,
5553       "cust_main.agentnum = $1";
5554   }
5555
5556   ##
5557   # parse status
5558   ##
5559
5560   #prospect active inactive suspended cancelled
5561   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
5562     my $method = $params->{'status'}. '_sql';
5563     #push @where, $class->$method();
5564     push @where, FS::cust_main->$method();
5565   }
5566
5567   ##
5568   # parse cancelled package checkbox
5569   ##
5570
5571   my $pkgwhere = "";
5572
5573   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
5574     unless $params->{'cancelled_pkgs'};
5575
5576   ##
5577   # dates
5578   ##
5579
5580   foreach my $field (qw( signupdate )) {
5581
5582     next unless exists($params->{$field});
5583
5584     my($beginning, $ending) = @{$params->{$field}};
5585
5586     push @where,
5587       "cust_main.$field IS NOT NULL",
5588       "cust_main.$field >= $beginning",
5589       "cust_main.$field <= $ending";
5590
5591     $orderby ||= "ORDER BY cust_main.$field";
5592
5593   }
5594
5595   ###
5596   # payby
5597   ###
5598
5599   my @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
5600   if ( @payby ) {
5601     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )';
5602   }
5603
5604   ##
5605   # amounts
5606   ##
5607
5608   #my $balance_sql = $class->balance_sql();
5609   my $balance_sql = FS::cust_main->balance_sql();
5610
5611   push @where, map { s/current_balance/$balance_sql/; $_ }
5612                    @{ $params->{'current_balance'} };
5613
5614   ##
5615   # custbatch
5616   ##
5617
5618   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
5619     push @where,
5620       "cust_main.custbatch = '$1'";
5621   }
5622
5623   ##
5624   # setup queries, subs, etc. for the search
5625   ##
5626
5627   $orderby ||= 'ORDER BY custnum';
5628
5629   # here is the agent virtualization
5630   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
5631
5632   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
5633
5634   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
5635
5636   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
5637
5638   my $select = join(', ',
5639                  'cust_main.custnum',
5640                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
5641                );
5642
5643   my(@extra_headers) = ();
5644   my(@extra_fields)  = ();
5645
5646   if ($params->{'flattened_pkgs'}) {
5647
5648     if ($dbh->{Driver}->{Name} eq 'Pg') {
5649
5650       $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";
5651
5652     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
5653       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
5654       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
5655     }else{
5656       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
5657            "omitting packing information from report.";
5658     }
5659
5660     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";
5661
5662     my $sth = dbh->prepare($header_query) or die dbh->errstr;
5663     $sth->execute() or die $sth->errstr;
5664     my $headerrow = $sth->fetchrow_arrayref;
5665     my $headercount = $headerrow ? $headerrow->[0] : 0;
5666     while($headercount) {
5667       unshift @extra_headers, "Package ". $headercount;
5668       unshift @extra_fields, eval q!sub {my $c = shift;
5669                                          my @a = split '\|', $c->magic;
5670                                          my $p = $a[!.--$headercount. q!];
5671                                          $p;
5672                                         };!;
5673     }
5674
5675   }
5676
5677   my $sql_query = {
5678     'table'         => 'cust_main',
5679     'select'        => $select,
5680     'hashref'       => {},
5681     'extra_sql'     => $extra_sql,
5682     'order_by'      => $orderby,
5683     'count_query'   => $count_query,
5684     'extra_headers' => \@extra_headers,
5685     'extra_fields'  => \@extra_fields,
5686   };
5687
5688 }
5689
5690 =item email_search_sql HASHREF
5691
5692 (Class method)
5693
5694 Emails a notice to the specified customers.
5695
5696 Valid parameters are those of the L<search_sql> method, plus the following:
5697
5698 =over 4
5699
5700 =item from
5701
5702 From: address
5703
5704 =item subject
5705
5706 Email Subject:
5707
5708 =item html_body
5709
5710 HTML body
5711
5712 =item text_body
5713
5714 Text body
5715
5716 =item job
5717
5718 Optional job queue job for status updates.
5719
5720 =back
5721
5722 Returns an error message, or false for success.
5723
5724 If an error occurs during any email, stops the enture send and returns that
5725 error.  Presumably if you're getting SMTP errors aborting is better than
5726 retrying everything.
5727
5728 =cut
5729
5730 sub email_search_sql {
5731   my($class, $params) = @_;
5732
5733   my $from = delete $params->{from};
5734   my $subject = delete $params->{subject};
5735   my $html_body = delete $params->{html_body};
5736   my $text_body = delete $params->{text_body};
5737
5738   my $job = delete $params->{'job'};
5739
5740   my $sql_query = $class->search_sql($params);
5741
5742   my $count_query   = delete($sql_query->{'count_query'});
5743   my $count_sth = dbh->prepare($count_query)
5744     or die "Error preparing $count_query: ". dbh->errstr;
5745   $count_sth->execute
5746     or die "Error executing $count_query: ". $count_sth->errstr;
5747   my $count_arrayref = $count_sth->fetchrow_arrayref;
5748   my $num_cust = $count_arrayref->[0];
5749
5750   #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
5751   #my @extra_fields  = @{ delete($sql_query->{'extra_fields'})  };
5752
5753
5754   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
5755
5756   #eventually order+limit magic to reduce memory use?
5757   foreach my $cust_main ( qsearch($sql_query) ) {
5758
5759     my $to = $cust_main->invoicing_list_emailonly_scalar;
5760     next unless $to;
5761
5762     my $error = send_email(
5763       generate_email(
5764         'from'      => $from,
5765         'to'        => $to,
5766         'subject'   => $subject,
5767         'html_body' => $html_body,
5768         'text_body' => $text_body,
5769       )
5770     );
5771     return $error if $error;
5772
5773     if ( $job ) { #progressbar foo
5774       $num++;
5775       if ( time - $min_sec > $last ) {
5776         my $error = $job->update_statustext(
5777           int( 100 * $num / $num_cust )
5778         );
5779         die $error if $error;
5780         $last = time;
5781       }
5782     }
5783
5784   }
5785
5786   return '';
5787 }
5788
5789 use Storable qw(thaw);
5790 use Data::Dumper;
5791 use MIME::Base64;
5792 sub process_email_search_sql {
5793   my $job = shift;
5794   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
5795
5796   my $param = thaw(decode_base64(shift));
5797   warn Dumper($param) if $DEBUG;
5798
5799   $param->{'job'} = $job;
5800
5801   my $error = FS::cust_main->email_search_sql( $param );
5802   die $error if $error;
5803
5804 }
5805
5806 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
5807
5808 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
5809 records.  Currently, I<first>, I<last> and/or I<company> may be specified (the
5810 appropriate ship_ field is also searched).
5811
5812 Additional options are the same as FS::Record::qsearch
5813
5814 =cut
5815
5816 sub fuzzy_search {
5817   my( $self, $fuzzy, $hash, @opt) = @_;
5818   #$self
5819   $hash ||= {};
5820   my @cust_main = ();
5821
5822   check_and_rebuild_fuzzyfiles();
5823   foreach my $field ( keys %$fuzzy ) {
5824
5825     my $all = $self->all_X($field);
5826     next unless scalar(@$all);
5827
5828     my %match = ();
5829     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
5830
5831     my @fcust = ();
5832     foreach ( keys %match ) {
5833       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
5834       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
5835     }
5836     my %fsaw = ();
5837     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
5838   }
5839
5840   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
5841   my %saw = ();
5842   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
5843
5844   @cust_main;
5845
5846 }
5847
5848 =item masked FIELD
5849
5850 Returns a masked version of the named field
5851
5852 =cut
5853
5854 sub masked {
5855 my ($self,$field) = @_;
5856
5857 # Show last four
5858
5859 'x'x(length($self->getfield($field))-4).
5860   substr($self->getfield($field), (length($self->getfield($field))-4));
5861
5862 }
5863
5864 =back
5865
5866 =head1 SUBROUTINES
5867
5868 =over 4
5869
5870 =item smart_search OPTION => VALUE ...
5871
5872 Accepts the following options: I<search>, the string to search for.  The string
5873 will be searched for as a customer number, phone number, name or company name,
5874 as an exact, or, in some cases, a substring or fuzzy match (see the source code
5875 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
5876 skip fuzzy matching when an exact match is found.
5877
5878 Any additional options are treated as an additional qualifier on the search
5879 (i.e. I<agentnum>).
5880
5881 Returns a (possibly empty) array of FS::cust_main objects.
5882
5883 =cut
5884
5885 sub smart_search {
5886   my %options = @_;
5887
5888   #here is the agent virtualization
5889   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
5890
5891   my @cust_main = ();
5892
5893   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
5894   my $search = delete $options{'search'};
5895   ( my $alphanum_search = $search ) =~ s/\W//g;
5896
5897   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
5898
5899     #false laziness w/Record::ut_phone
5900     my $phonen = "$1-$2-$3";
5901     $phonen .= " x$4" if $4;
5902
5903     push @cust_main, qsearch( {
5904       'table'   => 'cust_main',
5905       'hashref' => { %options },
5906       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5907                      ' ( '.
5908                          join(' OR ', map "$_ = '$phonen'",
5909                                           qw( daytime night fax
5910                                               ship_daytime ship_night ship_fax )
5911                              ).
5912                      ' ) '.
5913                      " AND $agentnums_sql", #agent virtualization
5914     } );
5915
5916     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
5917       #try looking for matches with extensions unless one was specified
5918
5919       push @cust_main, qsearch( {
5920         'table'   => 'cust_main',
5921         'hashref' => { %options },
5922         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
5923                        ' ( '.
5924                            join(' OR ', map "$_ LIKE '$phonen\%'",
5925                                             qw( daytime night
5926                                                 ship_daytime ship_night )
5927                                ).
5928                        ' ) '.
5929                        " AND $agentnums_sql", #agent virtualization
5930       } );
5931
5932     }
5933
5934   # custnum search (also try agent_custid), with some tweaking options if your
5935   # legacy cust "numbers" have letters
5936   } elsif ( $search =~ /^\s*(\d+)\s*$/
5937             || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
5938                  && $search =~ /^\s*(\w\w?\d+)\s*$/
5939                )
5940           )
5941   {
5942
5943     push @cust_main, qsearch( {
5944       'table'     => 'cust_main',
5945       'hashref'   => { 'custnum' => $1, %options },
5946       'extra_sql' => " AND $agentnums_sql", #agent virtualization
5947     } );
5948
5949     push @cust_main, qsearch( {
5950       'table'     => 'cust_main',
5951       'hashref'   => { 'agent_custid' => $1, %options },
5952       'extra_sql' => " AND $agentnums_sql", #agent virtualization
5953     } );
5954
5955   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
5956
5957     my($company, $last, $first) = ( $1, $2, $3 );
5958
5959     # "Company (Last, First)"
5960     #this is probably something a browser remembered,
5961     #so just do an exact search
5962
5963     foreach my $prefix ( '', 'ship_' ) {
5964       push @cust_main, qsearch( {
5965         'table'     => 'cust_main',
5966         'hashref'   => { $prefix.'first'   => $first,
5967                          $prefix.'last'    => $last,
5968                          $prefix.'company' => $company,
5969                          %options,
5970                        },
5971         'extra_sql' => " AND $agentnums_sql",
5972       } );
5973     }
5974
5975   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
5976                                               # try (ship_){last,company}
5977
5978     my $value = lc($1);
5979
5980     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
5981     # # full strings the browser remembers won't work
5982     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
5983
5984     use Lingua::EN::NameParse;
5985     my $NameParse = new Lingua::EN::NameParse(
5986              auto_clean     => 1,
5987              allow_reversed => 1,
5988     );
5989
5990     my($last, $first) = ( '', '' );
5991     #maybe disable this too and just rely on NameParse?
5992     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
5993
5994       ($last, $first) = ( $1, $2 );
5995
5996     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
5997     } elsif ( ! $NameParse->parse($value) ) {
5998
5999       my %name = $NameParse->components;
6000       $first = $name{'given_name_1'};
6001       $last  = $name{'surname_1'};
6002
6003     }
6004
6005     if ( $first && $last ) {
6006
6007       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
6008
6009       #exact
6010       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6011       $sql .= "
6012         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
6013            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
6014         )";
6015
6016       push @cust_main, qsearch( {
6017         'table'     => 'cust_main',
6018         'hashref'   => \%options,
6019         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6020       } );
6021
6022       # or it just be something that was typed in... (try that in a sec)
6023
6024     }
6025
6026     my $q_value = dbh->quote($value);
6027
6028     #exact
6029     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
6030     $sql .= " (    LOWER(last)         = $q_value
6031                 OR LOWER(company)      = $q_value
6032                 OR LOWER(ship_last)    = $q_value
6033                 OR LOWER(ship_company) = $q_value
6034               )";
6035
6036     push @cust_main, qsearch( {
6037       'table'     => 'cust_main',
6038       'hashref'   => \%options,
6039       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
6040     } );
6041
6042     #no exact match, trying substring/fuzzy
6043     #always do substring & fuzzy (unless they're explicity config'ed off)
6044     #getting complaints searches are not returning enough
6045     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
6046
6047       #still some false laziness w/search_sql (was search/cust_main.cgi)
6048
6049       #substring
6050
6051       my @hashrefs = (
6052         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
6053         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
6054       );
6055
6056       if ( $first && $last ) {
6057
6058         push @hashrefs,
6059           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
6060             'last'         => { op=>'ILIKE', value=>"%$last%" },
6061           },
6062           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
6063             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
6064           },
6065         ;
6066
6067       } else {
6068
6069         push @hashrefs,
6070           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
6071           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
6072         ;
6073       }
6074
6075       foreach my $hashref ( @hashrefs ) {
6076
6077         push @cust_main, qsearch( {
6078           'table'     => 'cust_main',
6079           'hashref'   => { %$hashref,
6080                            %options,
6081                          },
6082           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
6083         } );
6084
6085       }
6086
6087       #fuzzy
6088       my @fuzopts = (
6089         \%options,                #hashref
6090         '',                       #select
6091         " AND $agentnums_sql",    #extra_sql  #agent virtualization
6092       );
6093
6094       if ( $first && $last ) {
6095         push @cust_main, FS::cust_main->fuzzy_search(
6096           { 'last'   => $last,    #fuzzy hashref
6097             'first'  => $first }, #
6098           @fuzopts
6099         );
6100       }
6101       foreach my $field ( 'last', 'company' ) {
6102         push @cust_main,
6103           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
6104       }
6105
6106     }
6107
6108     #eliminate duplicates
6109     my %saw = ();
6110     @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6111
6112   }
6113
6114   @cust_main;
6115
6116 }
6117
6118 =item email_search
6119
6120 Accepts the following options: I<email>, the email address to search for.  The
6121 email address will be searched for as an email invoice destination and as an
6122 svc_acct account.
6123
6124 #Any additional options are treated as an additional qualifier on the search
6125 #(i.e. I<agentnum>).
6126
6127 Returns a (possibly empty) array of FS::cust_main objects (but usually just
6128 none or one).
6129
6130 =cut
6131
6132 sub email_search {
6133   my %options = @_;
6134
6135   local($DEBUG) = 1;
6136
6137   my $email = delete $options{'email'};
6138
6139   #we're only being used by RT at the moment... no agent virtualization yet
6140   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
6141
6142   my @cust_main = ();
6143
6144   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
6145
6146     my ( $user, $domain ) = ( $1, $2 );
6147
6148     warn "$me smart_search: searching for $user in domain $domain"
6149       if $DEBUG;
6150
6151     push @cust_main,
6152       map $_->cust_main,
6153           qsearch( {
6154                      'table'     => 'cust_main_invoice',
6155                      'hashref'   => { 'dest' => $email },
6156                    }
6157                  );
6158
6159     push @cust_main,
6160       map  $_->cust_main,
6161       grep $_,
6162       map  $_->cust_svc->cust_pkg,
6163           qsearch( {
6164                      'table'     => 'svc_acct',
6165                      'hashref'   => { 'username' => $user, },
6166                      'extra_sql' =>
6167                        'AND ( SELECT domain FROM svc_domain
6168                                 WHERE svc_acct.domsvc = svc_domain.svcnum
6169                             ) = '. dbh->quote($domain),
6170                    }
6171                  );
6172   }
6173
6174   my %saw = ();
6175   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
6176
6177   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
6178     if $DEBUG;
6179
6180   @cust_main;
6181
6182 }
6183
6184 =item check_and_rebuild_fuzzyfiles
6185
6186 =cut
6187
6188 use vars qw(@fuzzyfields);
6189 @fuzzyfields = ( 'last', 'first', 'company' );
6190
6191 sub check_and_rebuild_fuzzyfiles {
6192   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6193   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
6194 }
6195
6196 =item rebuild_fuzzyfiles
6197
6198 =cut
6199
6200 sub rebuild_fuzzyfiles {
6201
6202   use Fcntl qw(:flock);
6203
6204   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6205   mkdir $dir, 0700 unless -d $dir;
6206
6207   foreach my $fuzzy ( @fuzzyfields ) {
6208
6209     open(LOCK,">>$dir/cust_main.$fuzzy")
6210       or die "can't open $dir/cust_main.$fuzzy: $!";
6211     flock(LOCK,LOCK_EX)
6212       or die "can't lock $dir/cust_main.$fuzzy: $!";
6213
6214     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
6215       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
6216
6217     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
6218       my $sth = dbh->prepare("SELECT $field FROM cust_main".
6219                              " WHERE $field != '' AND $field IS NOT NULL");
6220       $sth->execute or die $sth->errstr;
6221
6222       while ( my $row = $sth->fetchrow_arrayref ) {
6223         print CACHE $row->[0]. "\n";
6224       }
6225
6226     }
6227
6228     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
6229
6230     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
6231     close LOCK;
6232   }
6233
6234 }
6235
6236 =item all_X
6237
6238 =cut
6239
6240 sub all_X {
6241   my( $self, $field ) = @_;
6242   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6243   open(CACHE,"<$dir/cust_main.$field")
6244     or die "can't open $dir/cust_main.$field: $!";
6245   my @array = map { chomp; $_; } <CACHE>;
6246   close CACHE;
6247   \@array;
6248 }
6249
6250 =item append_fuzzyfiles LASTNAME COMPANY
6251
6252 =cut
6253
6254 sub append_fuzzyfiles {
6255   #my( $first, $last, $company ) = @_;
6256
6257   &check_and_rebuild_fuzzyfiles;
6258
6259   use Fcntl qw(:flock);
6260
6261   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
6262
6263   foreach my $field (qw( first last company )) {
6264     my $value = shift;
6265
6266     if ( $value ) {
6267
6268       open(CACHE,">>$dir/cust_main.$field")
6269         or die "can't open $dir/cust_main.$field: $!";
6270       flock(CACHE,LOCK_EX)
6271         or die "can't lock $dir/cust_main.$field: $!";
6272
6273       print CACHE "$value\n";
6274
6275       flock(CACHE,LOCK_UN)
6276         or die "can't unlock $dir/cust_main.$field: $!";
6277       close CACHE;
6278     }
6279
6280   }
6281
6282   1;
6283 }
6284
6285 =item process_batch_import
6286
6287 Load a batch import as a queued JSRPC job
6288
6289 =cut
6290
6291 use Storable qw(thaw);
6292 use Data::Dumper;
6293 use MIME::Base64;
6294 sub process_batch_import {
6295   my $job = shift;
6296
6297   my $param = thaw(decode_base64(shift));
6298   warn Dumper($param) if $DEBUG;
6299
6300   my $files = $param->{'uploaded_files'}
6301     or die "No files provided.\n";
6302
6303   my (%files) = map { /^(\w+):([\.\w]+)$/ ? ($1,$2):() } split /,/, $files;
6304
6305   my $dir = '%%%FREESIDE_CACHE%%%/cache.'. $FS::UID::datasrc. '/';
6306   my $file = $dir. $files{'file'};
6307
6308   my $type;
6309   if ( $file =~ /\.(\w+)$/i ) {
6310     $type = lc($1);
6311   } else {
6312     #or error out???
6313     warn "can't parse file type from filename $file; defaulting to CSV";
6314     $type = 'csv';
6315   }
6316
6317   my $error =
6318     FS::cust_main::batch_import( {
6319       job       => $job,
6320       file      => $file,
6321       type      => $type,
6322       custbatch => $param->{custbatch},
6323       agentnum  => $param->{'agentnum'},
6324       refnum    => $param->{'refnum'},
6325       pkgpart   => $param->{'pkgpart'},
6326       #'fields'  => [qw( cust_pkg.setup dayphone first last address1 address2
6327       #                 city state zip comments                          )],
6328       'format'  => $param->{'format'},
6329     } );
6330
6331   unlink $file;
6332
6333   die "$error\n" if $error;
6334
6335 }
6336
6337 =item batch_import
6338
6339 =cut
6340
6341 #some false laziness w/cdr.pm now
6342 sub batch_import {
6343   my $param = shift;
6344
6345   my $job       = $param->{job};
6346
6347   my $filename  = $param->{file};
6348   my $type      = $param->{type} || 'csv';
6349
6350   my $custbatch = $param->{custbatch};
6351
6352   my $agentnum  = $param->{agentnum};
6353   my $refnum    = $param->{refnum};
6354   my $pkgpart   = $param->{pkgpart};
6355
6356   my $format    = $param->{'format'};
6357
6358   my @fields;
6359   my $payby;
6360   if ( $format eq 'simple' ) {
6361     @fields = qw( cust_pkg.setup dayphone first last
6362                   address1 address2 city state zip comments );
6363     $payby = 'BILL';
6364   } elsif ( $format eq 'extended' ) {
6365     @fields = qw( agent_custid refnum
6366                   last first address1 address2 city state zip country
6367                   daytime night
6368                   ship_last ship_first ship_address1 ship_address2
6369                   ship_city ship_state ship_zip ship_country
6370                   payinfo paycvv paydate
6371                   invoicing_list
6372                   cust_pkg.pkgpart
6373                   svc_acct.username svc_acct._password
6374                 );
6375     $payby = 'BILL';
6376  } elsif ( $format eq 'extended-plus_company' ) {
6377     @fields = qw( agent_custid refnum
6378                   last first company address1 address2 city state zip country
6379                   daytime night
6380                   ship_last ship_first ship_company ship_address1 ship_address2
6381                   ship_city ship_state ship_zip ship_country
6382                   payinfo paycvv paydate
6383                   invoicing_list
6384                   cust_pkg.pkgpart
6385                   svc_acct.username svc_acct._password
6386                 );
6387     $payby = 'BILL';
6388   } else {
6389     die "unknown format $format";
6390   }
6391
6392   my $count;
6393   my $parser;
6394   my @buffer = ();
6395   if ( $type eq 'csv' ) {
6396
6397     eval "use Text::CSV_XS;";
6398     die $@ if $@;
6399
6400     $parser = new Text::CSV_XS;
6401
6402     @buffer = split(/\r?\n/, slurp($filename) );
6403     $count = scalar(@buffer);
6404
6405   } elsif ( $type eq 'xls' ) {
6406
6407     eval "use Spreadsheet::ParseExcel;";
6408     die $@ if $@;
6409
6410     my $excel = new Spreadsheet::ParseExcel::Workbook->Parse($filename);
6411     $parser = $excel->{Worksheet}[0]; #first sheet
6412
6413     $count = $parser->{MaxRow} || $parser->{MinRow};
6414     $count++;
6415
6416   } else {
6417     die "Unknown file type $type\n";
6418   }
6419
6420   #my $columns;
6421
6422   local $SIG{HUP} = 'IGNORE';
6423   local $SIG{INT} = 'IGNORE';
6424   local $SIG{QUIT} = 'IGNORE';
6425   local $SIG{TERM} = 'IGNORE';
6426   local $SIG{TSTP} = 'IGNORE';
6427   local $SIG{PIPE} = 'IGNORE';
6428
6429   my $oldAutoCommit = $FS::UID::AutoCommit;
6430   local $FS::UID::AutoCommit = 0;
6431   my $dbh = dbh;
6432
6433   my $line;
6434   my $row = 0;
6435   my( $last, $min_sec ) = ( time, 5 ); #progressbar foo
6436   while (1) {
6437
6438     my @columns = ();
6439     if ( $type eq 'csv' ) {
6440
6441       last unless scalar(@buffer);
6442       $line = shift(@buffer);
6443
6444       $parser->parse($line) or do {
6445         $dbh->rollback if $oldAutoCommit;
6446         return "can't parse: ". $parser->error_input();
6447       };
6448       @columns = $parser->fields();
6449
6450     } elsif ( $type eq 'xls' ) {
6451
6452       last if $row > ($parser->{MaxRow} || $parser->{MinRow});
6453
6454       my @row = @{ $parser->{Cells}[$row] };
6455       @columns = map $_->{Val}, @row;
6456
6457       #my $z = 'A';
6458       #warn $z++. ": $_\n" for @columns;
6459
6460     } else {
6461       die "Unknown file type $type\n";
6462     }
6463
6464     #warn join('-',@columns);
6465
6466     my %cust_main = (
6467       custbatch => $custbatch,
6468       agentnum  => $agentnum,
6469       refnum    => $refnum,
6470       country   => $conf->config('countrydefault') || 'US',
6471       payby     => $payby, #default
6472       paydate   => '12/2037', #default
6473     );
6474     my $billtime = time;
6475     my %cust_pkg = ( pkgpart => $pkgpart );
6476     my %svc_acct = ();
6477     foreach my $field ( @fields ) {
6478
6479       if ( $field =~ /^cust_pkg\.(pkgpart|setup|bill|susp|adjourn|expire|cancel)$/ ) {
6480
6481         #$cust_pkg{$1} = str2time( shift @$columns );
6482         if ( $1 eq 'pkgpart' ) {
6483           $cust_pkg{$1} = shift @columns;
6484         } elsif ( $1 eq 'setup' ) {
6485           $billtime = str2time(shift @columns);
6486         } else {
6487           $cust_pkg{$1} = str2time( shift @columns );
6488         }
6489
6490       } elsif ( $field =~ /^svc_acct\.(username|_password)$/ ) {
6491
6492         $svc_acct{$1} = shift @columns;
6493
6494       } else {
6495
6496         #refnum interception
6497         if ( $field eq 'refnum' && $columns[0] !~ /^\s*(\d+)\s*$/ ) {
6498
6499           my $referral = $columns[0];
6500           my %hash = ( 'referral' => $referral,
6501                        'agentnum' => $agentnum,
6502                        'disabled' => '',
6503                      );
6504
6505           my $part_referral = qsearchs('part_referral', \%hash )
6506                               || new FS::part_referral \%hash;
6507
6508           unless ( $part_referral->refnum ) {
6509             my $error = $part_referral->insert;
6510             if ( $error ) {
6511               $dbh->rollback if $oldAutoCommit;
6512               return "can't auto-insert advertising source: $referral: $error";
6513             }
6514           }
6515
6516           $columns[0] = $part_referral->refnum;
6517         }
6518
6519         my $value = shift @columns;
6520         $cust_main{$field} = $value if length($value);
6521       }
6522     }
6523
6524     $cust_main{'payby'} = 'CARD'
6525       if defined $cust_main{'payinfo'}
6526       && length  $cust_main{'payinfo'};
6527
6528     my $invoicing_list = $cust_main{'invoicing_list'}
6529                            ? [ delete $cust_main{'invoicing_list'} ]
6530                            : [];
6531
6532     my $cust_main = new FS::cust_main ( \%cust_main );
6533
6534     use Tie::RefHash;
6535     tie my %hash, 'Tie::RefHash'; #this part is important
6536
6537     if ( $cust_pkg{'pkgpart'} ) {
6538       my $cust_pkg = new FS::cust_pkg ( \%cust_pkg );
6539
6540       my @svc_acct = ();
6541       if ( $svc_acct{'username'} ) {
6542         my $part_pkg = $cust_pkg->part_pkg;
6543         unless ( $part_pkg ) {
6544           $dbh->rollback if $oldAutoCommit;
6545           return "unknown pkgpart: ". $cust_pkg{'pkgpart'};
6546         }
6547         $svc_acct{svcpart} = $part_pkg->svcpart( 'svc_acct' );
6548         push @svc_acct, new FS::svc_acct ( \%svc_acct )
6549       }
6550
6551       $hash{$cust_pkg} = \@svc_acct;
6552     }
6553
6554     my $error = $cust_main->insert( \%hash, $invoicing_list );
6555
6556     if ( $error ) {
6557       $dbh->rollback if $oldAutoCommit;
6558       return "can't insert customer". ( $line ? " for $line" : '' ). ": $error";
6559     }
6560
6561     if ( $format eq 'simple' ) {
6562
6563       #false laziness w/bill.cgi
6564       $error = $cust_main->bill( 'time' => $billtime );
6565       if ( $error ) {
6566         $dbh->rollback if $oldAutoCommit;
6567         return "can't bill customer for $line: $error";
6568       }
6569
6570       $error = $cust_main->apply_payments_and_credits;
6571       if ( $error ) {
6572         $dbh->rollback if $oldAutoCommit;
6573         return "can't bill customer for $line: $error";
6574       }
6575
6576       $error = $cust_main->collect();
6577       if ( $error ) {
6578         $dbh->rollback if $oldAutoCommit;
6579         return "can't collect customer for $line: $error";
6580       }
6581
6582     }
6583
6584     $row++;
6585
6586     if ( $job && time - $min_sec > $last ) { #progress bar
6587       $job->update_statustext( int(100 * $row / $count) );
6588       $last = time;
6589     }
6590
6591   }
6592
6593   $dbh->commit or die $dbh->errstr if $oldAutoCommit;;
6594
6595   return "Empty file!" unless $row;
6596
6597   ''; #no error
6598
6599 }
6600
6601 =item batch_charge
6602
6603 =cut
6604
6605 sub batch_charge {
6606   my $param = shift;
6607   #warn join('-',keys %$param);
6608   my $fh = $param->{filehandle};
6609   my @fields = @{$param->{fields}};
6610
6611   eval "use Text::CSV_XS;";
6612   die $@ if $@;
6613
6614   my $csv = new Text::CSV_XS;
6615   #warn $csv;
6616   #warn $fh;
6617
6618   my $imported = 0;
6619   #my $columns;
6620
6621   local $SIG{HUP} = 'IGNORE';
6622   local $SIG{INT} = 'IGNORE';
6623   local $SIG{QUIT} = 'IGNORE';
6624   local $SIG{TERM} = 'IGNORE';
6625   local $SIG{TSTP} = 'IGNORE';
6626   local $SIG{PIPE} = 'IGNORE';
6627
6628   my $oldAutoCommit = $FS::UID::AutoCommit;
6629   local $FS::UID::AutoCommit = 0;
6630   my $dbh = dbh;
6631
6632   #while ( $columns = $csv->getline($fh) ) {
6633   my $line;
6634   while ( defined($line=<$fh>) ) {
6635
6636     $csv->parse($line) or do {
6637       $dbh->rollback if $oldAutoCommit;
6638       return "can't parse: ". $csv->error_input();
6639     };
6640
6641     my @columns = $csv->fields();
6642     #warn join('-',@columns);
6643
6644     my %row = ();
6645     foreach my $field ( @fields ) {
6646       $row{$field} = shift @columns;
6647     }
6648
6649     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
6650     unless ( $cust_main ) {
6651       $dbh->rollback if $oldAutoCommit;
6652       return "unknown custnum $row{'custnum'}";
6653     }
6654
6655     if ( $row{'amount'} > 0 ) {
6656       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
6657       if ( $error ) {
6658         $dbh->rollback if $oldAutoCommit;
6659         return $error;
6660       }
6661       $imported++;
6662     } elsif ( $row{'amount'} < 0 ) {
6663       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
6664                                       $row{'pkg'}                         );
6665       if ( $error ) {
6666         $dbh->rollback if $oldAutoCommit;
6667         return $error;
6668       }
6669       $imported++;
6670     } else {
6671       #hmm?
6672     }
6673
6674   }
6675
6676   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6677
6678   return "Empty file!" unless $imported;
6679
6680   ''; #no error
6681
6682 }
6683
6684 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6685
6686 Sends a templated email notification to the customer (see L<Text::Template>).
6687
6688 OPTIONS is a hash and may include
6689
6690 I<from> - the email sender (default is invoice_from)
6691
6692 I<to> - comma-separated scalar or arrayref of recipients
6693    (default is invoicing_list)
6694
6695 I<subject> - The subject line of the sent email notification
6696    (default is "Notice from company_name")
6697
6698 I<extra_fields> - a hashref of name/value pairs which will be substituted
6699    into the template
6700
6701 The following variables are vavailable in the template.
6702
6703 I<$first> - the customer first name
6704 I<$last> - the customer last name
6705 I<$company> - the customer company
6706 I<$payby> - a description of the method of payment for the customer
6707             # would be nice to use FS::payby::shortname
6708 I<$payinfo> - the account information used to collect for this customer
6709 I<$expdate> - the expiration of the customer payment in seconds from epoch
6710
6711 =cut
6712
6713 sub notify {
6714   my ($customer, $template, %options) = @_;
6715
6716   return unless $conf->exists($template);
6717
6718   my $from = $conf->config('invoice_from') if $conf->exists('invoice_from');
6719   $from = $options{from} if exists($options{from});
6720
6721   my $to = join(',', $customer->invoicing_list_emailonly);
6722   $to = $options{to} if exists($options{to});
6723
6724   my $subject = "Notice from " . $conf->config('company_name')
6725     if $conf->exists('company_name');
6726   $subject = $options{subject} if exists($options{subject});
6727
6728   my $notify_template = new Text::Template (TYPE => 'ARRAY',
6729                                             SOURCE => [ map "$_\n",
6730                                               $conf->config($template)]
6731                                            )
6732     or die "can't create new Text::Template object: Text::Template::ERROR";
6733   $notify_template->compile()
6734     or die "can't compile template: Text::Template::ERROR";
6735
6736   $FS::notify_template::_template::company_name = $conf->config('company_name');
6737   $FS::notify_template::_template::company_address =
6738     join("\n", $conf->config('company_address') ). "\n";
6739
6740   my $paydate = $customer->paydate || '2037-12-31';
6741   $FS::notify_template::_template::first = $customer->first;
6742   $FS::notify_template::_template::last = $customer->last;
6743   $FS::notify_template::_template::company = $customer->company;
6744   $FS::notify_template::_template::payinfo = $customer->mask_payinfo;
6745   my $payby = $customer->payby;
6746   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6747   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6748
6749   #credit cards expire at the end of the month/year of their exp date
6750   if ($payby eq 'CARD' || $payby eq 'DCRD') {
6751     $FS::notify_template::_template::payby = 'credit card';
6752     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6753     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6754     $expire_time--;
6755   }elsif ($payby eq 'COMP') {
6756     $FS::notify_template::_template::payby = 'complimentary account';
6757   }else{
6758     $FS::notify_template::_template::payby = 'current method';
6759   }
6760   $FS::notify_template::_template::expdate = $expire_time;
6761
6762   for (keys %{$options{extra_fields}}){
6763     no strict "refs";
6764     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
6765   }
6766
6767   send_email(from => $from,
6768              to => $to,
6769              subject => $subject,
6770              body => $notify_template->fill_in( PACKAGE =>
6771                                                 'FS::notify_template::_template'                                              ),
6772             );
6773
6774 }
6775
6776 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
6777
6778 Generates a templated notification to the customer (see L<Text::Template>).
6779
6780 OPTIONS is a hash and may include
6781
6782 I<extra_fields> - a hashref of name/value pairs which will be substituted
6783    into the template.  These values may override values mentioned below
6784    and those from the customer record.
6785
6786 The following variables are available in the template instead of or in addition
6787 to the fields of the customer record.
6788
6789 I<$payby> - a description of the method of payment for the customer
6790             # would be nice to use FS::payby::shortname
6791 I<$payinfo> - the masked account information used to collect for this customer
6792 I<$expdate> - the expiration of the customer payment method in seconds from epoch
6793 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
6794
6795 =cut
6796
6797 sub generate_letter {
6798   my ($self, $template, %options) = @_;
6799
6800   return unless $conf->exists($template);
6801
6802   my $letter_template = new Text::Template
6803                         ( TYPE       => 'ARRAY',
6804                           SOURCE     => [ map "$_\n", $conf->config($template)],
6805                           DELIMITERS => [ '[@--', '--@]' ],
6806                         )
6807     or die "can't create new Text::Template object: Text::Template::ERROR";
6808
6809   $letter_template->compile()
6810     or die "can't compile template: Text::Template::ERROR";
6811
6812   my %letter_data = map { $_ => $self->$_ } $self->fields;
6813   $letter_data{payinfo} = $self->mask_payinfo;
6814
6815   #my $paydate = $self->paydate || '2037-12-31';
6816   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
6817
6818   my $payby = $self->payby;
6819   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
6820   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
6821
6822   #credit cards expire at the end of the month/year of their exp date
6823   if ($payby eq 'CARD' || $payby eq 'DCRD') {
6824     $letter_data{payby} = 'credit card';
6825     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
6826     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
6827     $expire_time--;
6828   }elsif ($payby eq 'COMP') {
6829     $letter_data{payby} = 'complimentary account';
6830   }else{
6831     $letter_data{payby} = 'current method';
6832   }
6833   $letter_data{expdate} = $expire_time;
6834
6835   for (keys %{$options{extra_fields}}){
6836     $letter_data{$_} = $options{extra_fields}->{$_};
6837   }
6838
6839   unless(exists($letter_data{returnaddress})){
6840     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
6841                                                   $self->agent_template)
6842                      );
6843     if ( length($retadd) ) {
6844       $letter_data{returnaddress} = $retadd;
6845     } elsif ( grep /\S/, $conf->config('company_address') ) {
6846       $letter_data{returnaddress} =
6847         join( '\\*'."\n", map s/( {2,})/'~' x length($1)/eg,
6848                           $conf->config('company_address')
6849         );
6850     } else {
6851       $letter_data{returnaddress} = '~';
6852     }
6853   }
6854
6855   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
6856
6857   $letter_data{company_name} = $conf->config('company_name');
6858
6859   my $dir = $FS::UID::conf_dir."cache.". $FS::UID::datasrc;
6860   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
6861                            DIR      => $dir,
6862                            SUFFIX   => '.tex',
6863                            UNLINK   => 0,
6864                          ) or die "can't open temp file: $!\n";
6865
6866   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
6867   close $fh;
6868   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
6869   return $1;
6870 }
6871
6872 =item print_ps TEMPLATE
6873
6874 Returns an postscript letter filled in from TEMPLATE, as a scalar.
6875
6876 =cut
6877
6878 sub print_ps {
6879   my $self = shift;
6880   my $file = $self->generate_letter(@_);
6881   FS::Misc::generate_ps($file);
6882 }
6883
6884 =item print TEMPLATE
6885
6886 Prints the filled in template.
6887
6888 TEMPLATE is the name of a L<Text::Template> to fill in and print.
6889
6890 =cut
6891
6892 sub queueable_print {
6893   my %opt = @_;
6894
6895   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
6896     or die "invalid customer number: " . $opt{custvnum};
6897
6898   my $error = $self->print( $opt{template} );
6899   die $error if $error;
6900 }
6901
6902 sub print {
6903   my ($self, $template) = (shift, shift);
6904   do_print [ $self->print_ps($template) ];
6905 }
6906
6907 sub agent_template {
6908   my $self = shift;
6909   $self->_agent_plandata('agent_templatename');
6910 }
6911
6912 sub agent_invoice_from {
6913   my $self = shift;
6914   $self->_agent_plandata('agent_invoice_from');
6915 }
6916
6917 sub _agent_plandata {
6918   my( $self, $option ) = @_;
6919
6920   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
6921   #agent-specific Conf
6922
6923   use FS::part_event::Condition;
6924
6925   my $agentnum = $self->agentnum;
6926
6927   my $regexp = '';
6928   if ( driver_name =~ /^Pg/i ) {
6929     $regexp = '~';
6930   } elsif ( driver_name =~ /^mysql/i ) {
6931     $regexp = 'REGEXP';
6932   } else {
6933     die "don't know how to use regular expressions in ". driver_name. " databases";
6934   }
6935
6936   my $part_event_option =
6937     qsearchs({
6938       'select'    => 'part_event_option.*',
6939       'table'     => 'part_event_option',
6940       'addl_from' => q{
6941         LEFT JOIN part_event USING ( eventpart )
6942         LEFT JOIN part_event_option AS peo_agentnum
6943           ON ( part_event.eventpart = peo_agentnum.eventpart
6944                AND peo_agentnum.optionname = 'agentnum'
6945                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
6946              )
6947         LEFT JOIN part_event_option AS peo_cust_bill_age
6948           ON ( part_event.eventpart = peo_cust_bill_age.eventpart
6949                AND peo_cust_bill_age.optionname = 'cust_bill_age'
6950              )
6951       },
6952       #'hashref'   => { 'optionname' => $option },
6953       #'hashref'   => { 'part_event_option.optionname' => $option },
6954       'extra_sql' =>
6955         " WHERE part_event_option.optionname = ". dbh->quote($option).
6956         " AND action = 'cust_bill_send_agent' ".
6957         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
6958         " AND peo_agentnum.optionname = 'agentnum' ".
6959         " AND agentnum IS NULL OR agentnum = $agentnum ".
6960         " ORDER BY
6961            CASE WHEN peo_cust_bill_age.optionname != 'cust_bill_age'
6962            THEN -1
6963            ELSE ". FS::part_event::Condition->age2seconds_sql('peo_cust_bill_age.optionvalue').
6964         " END
6965           , part_event.weight".
6966         " LIMIT 1"
6967     });
6968
6969   unless ( $part_event_option ) {
6970     return $self->agent->invoice_template || ''
6971       if $option eq 'agent_templatename';
6972     return '';
6973   }
6974
6975   $part_event_option->optionvalue;
6976
6977 }
6978
6979 sub queued_bill {
6980   ## actual sub, not a method, designed to be called from the queue.
6981   ## sets up the customer, and calls the bill_and_collect
6982   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
6983   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
6984       $cust_main->bill_and_collect(
6985         %args,
6986       );
6987 }
6988
6989 =back
6990
6991 =head1 BUGS
6992
6993 The delete method.
6994
6995 The delete method should possibly take an FS::cust_main object reference
6996 instead of a scalar customer number.
6997
6998 Bill and collect options should probably be passed as references instead of a
6999 list.
7000
7001 There should probably be a configuration file with a list of allowed credit
7002 card types.
7003
7004 No multiple currency support (probably a larger project than just this module).
7005
7006 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
7007
7008 Birthdates rely on negative epoch values.
7009
7010 The payby for card/check batches is broken.  With mixed batching, bad
7011 things will happen.
7012
7013 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
7014
7015 =head1 SEE ALSO
7016
7017 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
7018 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
7019 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
7020
7021 =cut
7022
7023 1;
7024