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