FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 require 5.006;
   4 use strict;
   5 use base qw( FS::cust_main::Billing FS::cust_main::Billing_Realtime
   6              FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
   7              FS::Record
   8            );
   9 use vars qw( $DEBUG $me $conf
  10              @encrypted_fields
  11              $import $ignore_expired_card $ignore_illegal_zip
  12              $skip_fuzzyfiles @fuzzyfields
  13              @paytypes
  14            );
  15 use vars qw( $realtime_bop_decline_quiet ); #ugh
  16 use Carp;
  17 use Scalar::Util qw( blessed );
  18 use List::Util qw( min );
  19 use Time::Local qw(timelocal);
  20 use Storable qw(thaw);
  21 use MIME::Base64;
  22 use Data::Dumper;
  23 use Tie::IxHash;
  24 use Digest::MD5 qw(md5_base64);
  25 use Date::Format;
  26 #use Date::Manip;
  27 use File::Temp qw( tempfile );
  28 use Business::CreditCard 0.28;
  29 use Locale::Country;
  30 use FS::UID qw( getotaker dbh driver_name );
  31 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
  32 use FS::Misc qw( generate_email send_email generate_ps do_print );
  33 use FS::Msgcat qw(gettext);
  34 use FS::CurrentUser;
  35 use FS::payby;
  36 use FS::cust_pkg;
  37 use FS::cust_svc;
  38 use FS::cust_bill;
  39 use FS::cust_pay;
  40 use FS::cust_pay_pending;
  41 use FS::cust_pay_void;
  42 use FS::cust_pay_batch;
  43 use FS::cust_credit;
  44 use FS::cust_refund;
  45 use FS::part_referral;
  46 use FS::cust_main_county;
  47 use FS::cust_location;
  48 use FS::cust_class;
  49 use FS::cust_main_exemption;
  50 use FS::cust_tax_adjustment;
  51 use FS::cust_tax_location;
  52 use FS::agent;
  53 use FS::cust_main_invoice;
  54 use FS::cust_tag;
  55 use FS::prepay_credit;
  56 use FS::queue;
  57 use FS::part_pkg;
  58 use FS::part_event;
  59 use FS::part_event_condition;
  60 use FS::part_export;
  61 #use FS::cust_event;
  62 use FS::type_pkgs;
  63 use FS::payment_gateway;
  64 use FS::agent_payment_gateway;
  65 use FS::banned_pay;
  66 use FS::TicketSystem;
  67
  68 $realtime_bop_decline_quiet = 0; #move to Billing_Realtime
  69
  70 # 1 is mostly method/subroutine entry and options
  71 # 2 traces progress of some operations
  72 # 3 is even more information including possibly sensitive data
  73 $DEBUG = 0;
  74 $me = '[FS::cust_main]';
  75
  76 $import = 0;
  77 $ignore_expired_card = 0;
  78 $ignore_illegal_zip = 0;
  79
  80 $skip_fuzzyfiles = 0;
  81 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
  82
  83 @encrypted_fields = ('payinfo', 'paycvv');
  84 sub nohistory_fields { ('payinfo', 'paycvv'); }
  85
  86 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
  87
  88 #ask FS::UID to run this stuff for us later
  89 #$FS::UID::callback{'FS::cust_main'} = sub {
  90 install_callback FS::UID sub {
  91   $conf = new FS::Conf;
  92   #yes, need it for stuff below (prolly should be cached)
  93 };
  94
  95 sub _cache {
  96   my $self = shift;
  97   my ( $hashref, $cache ) = @_;
  98   if ( exists $hashref->{'pkgnum'} ) {
  99     #@{ $self->{'_pkgnum'} } = ();
 100     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
 101     $self->{'_pkgnum'} = $subcache;
 102     #push @{ $self->{'_pkgnum'} },
 103     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
 104   }
 105 }
 106
 107 =head1 NAME
 108
 109 FS::cust_main - Object methods for cust_main records
 110
 111 =head1 SYNOPSIS
 112
 113   use FS::cust_main;
 114
 115   $record = new FS::cust_main \%hash;
 116   $record = new FS::cust_main { 'column' => 'value' };
 117
 118   $error = $record->insert;
 119
 120   $error = $new_record->replace($old_record);
 121
 122   $error = $record->delete;
 123
 124   $error = $record->check;
 125
 126   @cust_pkg = $record->all_pkgs;
 127
 128   @cust_pkg = $record->ncancelled_pkgs;
 129
 130   @cust_pkg = $record->suspended_pkgs;
 131
 132   $error = $record->bill;
 133   $error = $record->bill %options;
 134   $error = $record->bill 'time' => $time;
 135
 136   $error = $record->collect;
 137   $error = $record->collect %options;
 138   $error = $record->collect 'invoice_time'   => $time,
 139                           ;
 140
 141 =head1 DESCRIPTION
 142
 143 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 144 FS::Record.  The following fields are currently supported:
 145
 146 =over 4
 147
 148 =item custnum
 149
 150 Primary key (assigned automatically for new customers)
 151
 152 =item agentnum
 153
 154 Agent (see L<FS::agent>)
 155
 156 =item refnum
 157
 158 Advertising source (see L<FS::part_referral>)
 159
 160 =item first
 161
 162 First name
 163
 164 =item last
 165
 166 Last name
 167
 168 =item ss
 169
 170 Cocial security number (optional)
 171
 172 =item company
 173
 174 (optional)
 175
 176 =item address1
 177
 178 =item address2
 179
 180 (optional)
 181
 182 =item city
 183
 184 =item county
 185
 186 (optional, see L<FS::cust_main_county>)
 187
 188 =item state
 189
 190 (see L<FS::cust_main_county>)
 191
 192 =item zip
 193
 194 =item country
 195
 196 (see L<FS::cust_main_county>)
 197
 198 =item daytime
 199
 200 phone (optional)
 201
 202 =item night
 203
 204 phone (optional)
 205
 206 =item fax
 207
 208 phone (optional)
 209
 210 =item ship_first
 211
 212 Shipping first name
 213
 214 =item ship_last
 215
 216 Shipping last name
 217
 218 =item ship_company
 219
 220 (optional)
 221
 222 =item ship_address1
 223
 224 =item ship_address2
 225
 226 (optional)
 227
 228 =item ship_city
 229
 230 =item ship_county
 231
 232 (optional, see L<FS::cust_main_county>)
 233
 234 =item ship_state
 235
 236 (see L<FS::cust_main_county>)
 237
 238 =item ship_zip
 239
 240 =item ship_country
 241
 242 (see L<FS::cust_main_county>)
 243
 244 =item ship_daytime
 245
 246 phone (optional)
 247
 248 =item ship_night
 249
 250 phone (optional)
 251
 252 =item ship_fax
 253
 254 phone (optional)
 255
 256 =item payby
 257
 258 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
 259
 260 =item payinfo
 261
 262 Payment Information (See L<FS::payinfo_Mixin> for data format)
 263
 264 =item paymask
 265
 266 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
 267
 268 =item paycvv
 269
 270 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
 271
 272 =item paydate
 273
 274 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 275
 276 =item paystart_month
 277
 278 Start date month (maestro/solo cards only)
 279
 280 =item paystart_year
 281
 282 Start date year (maestro/solo cards only)
 283
 284 =item payissue
 285
 286 Issue number (maestro/solo cards only)
 287
 288 =item payname
 289
 290 Name on card or billing name
 291
 292 =item payip
 293
 294 IP address from which payment information was received
 295
 296 =item tax
 297
 298 Tax exempt, empty or `Y'
 299
 300 =item usernum
 301
 302 Order taker (see L<FS::access_user>)
 303
 304 =item comments
 305
 306 Comments (optional)
 307
 308 =item referral_custnum
 309
 310 Referring customer number
 311
 312 =item spool_cdr
 313
 314 Enable individual CDR spooling, empty or `Y'
 315
 316 =item dundate
 317
 318 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
 319
 320 =item squelch_cdr
 321
 322 Discourage individual CDR printing, empty or `Y'
 323
 324 =back
 325
 326 =head1 METHODS
 327
 328 =over 4
 329
 330 =item new HASHREF
 331
 332 Creates a new customer.  To add the customer to the database, see L<"insert">.
 333
 334 Note that this stores the hash reference, not a distinct copy of the hash it
 335 points to.  You can ask the object for a copy with the I<hash> method.
 336
 337 =cut
 338
 339 sub table { 'cust_main'; }
 340
 341 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 342
 343 Adds this customer to the database.  If there is an error, returns the error,
 344 otherwise returns false.
 345
 346 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 347 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 348 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 349 hash reference is equivalent to not supplying this parameter.  There should be
 350 a better explanation of this, but until then, here's an example:
 351
 352   use Tie::RefHash;
 353   tie %hash, 'Tie::RefHash'; #this part is important
 354   %hash = (
 355     $cust_pkg => [ $svc_acct ],
 356     ...
 357   );
 358   $cust_main->insert( \%hash );
 359
 360 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 361 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 362 expected and rollback the entire transaction; it is not necessary to call
 363 check_invoicing_list first.  The invoicing_list is set after the records in the
 364 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 365 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 366
 367   $cust_main->insert( {}, [ $email, 'POST' ] );
 368
 369 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
 370
 371 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 372 on the supplied jobnum (they will not run until the specific job completes).
 373 This can be used to defer provisioning until some action completes (such
 374 as running the customer's credit card successfully).
 375
 376 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 377 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 378 the B<reexport> method.)
 379
 380 The I<tax_exemption> option can be set to an arrayref of tax names.
 381 FS::cust_main_exemption records will be created and inserted.
 382
 383 =cut
 384
 385 sub insert {
 386   my $self = shift;
 387   my $cust_pkgs = @_ ? shift : {};
 388   my $invoicing_list = @_ ? shift : '';
 389   my %options = @_;
 390   warn "$me insert called with options ".
 391        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 392     if $DEBUG;
 393
 394   local $SIG{HUP} = 'IGNORE';
 395   local $SIG{INT} = 'IGNORE';
 396   local $SIG{QUIT} = 'IGNORE';
 397   local $SIG{TERM} = 'IGNORE';
 398   local $SIG{TSTP} = 'IGNORE';
 399   local $SIG{PIPE} = 'IGNORE';
 400
 401   my $oldAutoCommit = $FS::UID::AutoCommit;
 402   local $FS::UID::AutoCommit = 0;
 403   my $dbh = dbh;
 404
 405   my $prepay_identifier = '';
 406   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
 407   my $payby = '';
 408   if ( $self->payby eq 'PREPAY' ) {
 409
 410     $self->payby('BILL');
 411     $prepay_identifier = $self->payinfo;
 412     $self->payinfo('');
 413
 414     warn "  looking up prepaid card $prepay_identifier\n"
 415       if $DEBUG > 1;
 416
 417     my $error = $self->get_prepay( $prepay_identifier,
 418                                    'amount_ref'     => \$amount,
 419                                    'seconds_ref'    => \$seconds,
 420                                    'upbytes_ref'    => \$upbytes,
 421                                    'downbytes_ref'  => \$downbytes,
 422                                    'totalbytes_ref' => \$totalbytes,
 423                                  );
 424     if ( $error ) {
 425       $dbh->rollback if $oldAutoCommit;
 426       #return "error applying prepaid card (transaction rolled back): $error";
 427       return $error;
 428     }
 429
 430     $payby = 'PREP' if $amount;
 431
 432   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
 433
 434     $payby = $1;
 435     $self->payby('BILL');
 436     $amount = $self->paid;
 437
 438   }
 439
 440   warn "  inserting $self\n"
 441     if $DEBUG > 1;
 442
 443   $self->signupdate(time) unless $self->signupdate;
 444
 445   $self->auto_agent_custid()
 446     if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
 447
 448   my $error = $self->SUPER::insert;
 449   if ( $error ) {
 450     $dbh->rollback if $oldAutoCommit;
 451     #return "inserting cust_main record (transaction rolled back): $error";
 452     return $error;
 453   }
 454
 455   warn "  setting invoicing list\n"
 456     if $DEBUG > 1;
 457
 458   if ( $invoicing_list ) {
 459     $error = $self->check_invoicing_list( $invoicing_list );
 460     if ( $error ) {
 461       $dbh->rollback if $oldAutoCommit;
 462       #return "checking invoicing_list (transaction rolled back): $error";
 463       return $error;
 464     }
 465     $self->invoicing_list( $invoicing_list );
 466   }
 467
 468   warn "  setting customer tags\n"
 469     if $DEBUG > 1;
 470
 471   foreach my $tagnum ( @{ $self->tagnum || [] } ) {
 472     my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
 473                                       'custnum' => $self->custnum };
 474     my $error = $cust_tag->insert;
 475     if ( $error ) {
 476       $dbh->rollback if $oldAutoCommit;
 477       return $error;
 478     }
 479   }
 480
 481   if ( $invoicing_list ) {
 482     $error = $self->check_invoicing_list( $invoicing_list );
 483     if ( $error ) {
 484       $dbh->rollback if $oldAutoCommit;
 485       #return "checking invoicing_list (transaction rolled back): $error";
 486       return $error;
 487     }
 488     $self->invoicing_list( $invoicing_list );
 489   }
 490
 491
 492   warn "  setting cust_main_exemption\n"
 493     if $DEBUG > 1;
 494
 495   my $tax_exemption = delete $options{'tax_exemption'};
 496   if ( $tax_exemption ) {
 497     foreach my $taxname ( @$tax_exemption ) {
 498       my $cust_main_exemption = new FS::cust_main_exemption {
 499         'custnum' => $self->custnum,
 500         'taxname' => $taxname,
 501       };
 502       my $error = $cust_main_exemption->insert;
 503       if ( $error ) {
 504         $dbh->rollback if $oldAutoCommit;
 505         return "inserting cust_main_exemption (transaction rolled back): $error";
 506       }
 507     }
 508   }
 509
 510   if (    $conf->config('cust_main-skeleton_tables')
 511        && $conf->config('cust_main-skeleton_custnum') ) {
 512
 513     warn "  inserting skeleton records\n"
 514       if $DEBUG > 1;
 515
 516     my $error = $self->start_copy_skel;
 517     if ( $error ) {
 518       $dbh->rollback if $oldAutoCommit;
 519       return $error;
 520     }
 521
 522   }
 523
 524   warn "  ordering packages\n"
 525     if $DEBUG > 1;
 526
 527   $error = $self->order_pkgs( $cust_pkgs,
 528                               %options,
 529                               'seconds_ref'    => \$seconds,
 530                               'upbytes_ref'    => \$upbytes,
 531                               'downbytes_ref'  => \$downbytes,
 532                               'totalbytes_ref' => \$totalbytes,
 533                             );
 534   if ( $error ) {
 535     $dbh->rollback if $oldAutoCommit;
 536     return $error;
 537   }
 538
 539   if ( $seconds ) {
 540     $dbh->rollback if $oldAutoCommit;
 541     return "No svc_acct record to apply pre-paid time";
 542   }
 543   if ( $upbytes || $downbytes || $totalbytes ) {
 544     $dbh->rollback if $oldAutoCommit;
 545     return "No svc_acct record to apply pre-paid data";
 546   }
 547
 548   if ( $amount ) {
 549     warn "  inserting initial $payby payment of $amount\n"
 550       if $DEBUG > 1;
 551     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
 552     if ( $error ) {
 553       $dbh->rollback if $oldAutoCommit;
 554       return "inserting payment (transaction rolled back): $error";
 555     }
 556   }
 557
 558   unless ( $import || $skip_fuzzyfiles ) {
 559     warn "  queueing fuzzyfiles update\n"
 560       if $DEBUG > 1;
 561     $error = $self->queue_fuzzyfiles_update;
 562     if ( $error ) {
 563       $dbh->rollback if $oldAutoCommit;
 564       return "updating fuzzy search cache: $error";
 565     }
 566   }
 567
 568   # cust_main exports!
 569   warn "  exporting\n" if $DEBUG > 1;
 570
 571   my $export_args = $options{'export_args'} || [];
 572
 573   my @part_export =
 574     map qsearch( 'part_export', {exportnum=>$_} ),
 575       $conf->config('cust_main-exports'); #, $agentnum
 576
 577   foreach my $part_export ( @part_export ) {
 578     my $error = $part_export->export_insert($self, @$export_args);
 579     if ( $error ) {
 580       $dbh->rollback if $oldAutoCommit;
 581       return "exporting to ". $part_export->exporttype.
 582              " (transaction rolled back): $error";
 583     }
 584   }
 585
 586   #foreach my $depend_jobnum ( @$depend_jobnums ) {
 587   #    warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 588   #      if $DEBUG;
 589   #    foreach my $jobnum ( @jobnums ) {
 590   #      my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 591   #      warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 592   #        if $DEBUG;
 593   #      my $error = $queue->depend_insert($depend_jobnum);
 594   #      if ( $error ) {
 595   #        $dbh->rollback if $oldAutoCommit;
 596   #        return "error queuing job dependancy: $error";
 597   #      }
 598   #    }
 599   #  }
 600   #
 601   #}
 602   #
 603   #if ( exists $options{'jobnums'} ) {
 604   #  push @{ $options{'jobnums'} }, @jobnums;
 605   #}
 606
 607   warn "  insert complete; committing transaction\n"
 608     if $DEBUG > 1;
 609
 610   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 611   '';
 612
 613 }
 614
 615 use File::CounterFile;
 616 sub auto_agent_custid {
 617   my $self = shift;
 618
 619   my $format = $conf->config('cust_main-auto_agent_custid');
 620   my $agent_custid;
 621   if ( $format eq '1YMMXXXXXXXX' ) {
 622
 623     my $counter = new File::CounterFile 'cust_main.agent_custid';
 624     $counter->lock;
 625
 626     my $ym = 100000000000 + time2str('%y%m00000000', time);
 627     if ( $ym > $counter->value ) {
 628       $counter->{'value'} = $agent_custid = $ym;
 629       $counter->{'updated'} = 1;
 630     } else {
 631       $agent_custid = $counter->inc;
 632     }
 633
 634     $counter->unlock;
 635
 636   } else {
 637     die "Unknown cust_main-auto_agent_custid format: $format";
 638   }
 639
 640   $self->agent_custid($agent_custid);
 641
 642 }
 643
 644 sub start_copy_skel {
 645   my $self = shift;
 646
 647   #'mg_user_preference' => {},
 648   #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
 649   #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
 650   #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
 651   #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
 652   my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
 653   die $@ if $@;
 654
 655   _copy_skel( 'cust_main',                                 #tablename
 656               $conf->config('cust_main-skeleton_custnum'), #sourceid
 657               $self->custnum,                              #destid
 658               @tables,                                     #child tables
 659             );
 660 }
 661
 662 #recursive subroutine, not a method
 663 sub _copy_skel {
 664   my( $table, $sourceid, $destid, %child_tables ) = @_;
 665
 666   my $primary_key;
 667   if ( $table =~ /^(\w+)\.(\w+)$/ ) {
 668     ( $table, $primary_key ) = ( $1, $2 );
 669   } else {
 670     my $dbdef_table = dbdef->table($table);
 671     $primary_key = $dbdef_table->primary_key
 672       or return "$table has no primary key".
 673                 " (or do you need to run dbdef-create?)";
 674   }
 675
 676   warn "  _copy_skel: $table.$primary_key $sourceid to $destid for ".
 677        join (', ', keys %child_tables). "\n"
 678     if $DEBUG > 2;
 679
 680   foreach my $child_table_def ( keys %child_tables ) {
 681
 682     my $child_table;
 683     my $child_pkey = '';
 684     if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
 685       ( $child_table, $child_pkey ) = ( $1, $2 );
 686     } else {
 687       $child_table = $child_table_def;
 688
 689       $child_pkey = dbdef->table($child_table)->primary_key;
 690       #  or return "$table has no primary key".
 691       #            " (or do you need to run dbdef-create?)\n";
 692     }
 693
 694     my $sequence = '';
 695     if ( keys %{ $child_tables{$child_table_def} } ) {
 696
 697       return "$child_table has no primary key".
 698              " (run dbdef-create or try specifying it?)\n"
 699         unless $child_pkey;
 700
 701       #false laziness w/Record::insert and only works on Pg
 702       #refactor the proper last-inserted-id stuff out of Record::insert if this
 703       # ever gets use for anything besides a quick kludge for one customer
 704       my $default = dbdef->table($child_table)->column($child_pkey)->default;
 705       $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
 706         or return "can't parse $child_table.$child_pkey default value ".
 707                   " for sequence name: $default";
 708       $sequence = $1;
 709
 710     }
 711
 712     my @sel_columns = grep { $_ ne $primary_key }
 713                            dbdef->table($child_table)->columns;
 714     my $sel_columns = join(', ', @sel_columns );
 715
 716     my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
 717     my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
 718     my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
 719
 720     my $sel_st = "SELECT $sel_columns FROM $child_table".
 721                  " WHERE $primary_key = $sourceid";
 722     warn "    $sel_st\n"
 723       if $DEBUG > 2;
 724     my $sel_sth = dbh->prepare( $sel_st )
 725       or return dbh->errstr;
 726
 727     $sel_sth->execute or return $sel_sth->errstr;
 728
 729     while ( my $row = $sel_sth->fetchrow_hashref ) {
 730
 731       warn "    selected row: ".
 732            join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
 733         if $DEBUG > 2;
 734
 735       my $statement =
 736         "INSERT INTO $child_table $ins_columns VALUES $placeholders";
 737       my $ins_sth =dbh->prepare($statement)
 738           or return dbh->errstr;
 739       my @param = ( $destid, map $row->{$_}, @ins_columns );
 740       warn "    $statement: [ ". join(', ', @param). " ]\n"
 741         if $DEBUG > 2;
 742       $ins_sth->execute( @param )
 743         or return $ins_sth->errstr;
 744
 745       #next unless keys %{ $child_tables{$child_table} };
 746       next unless $sequence;
 747
 748       #another section of that laziness
 749       my $seq_sql = "SELECT currval('$sequence')";
 750       my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
 751       $seq_sth->execute or return $seq_sth->errstr;
 752       my $insertid = $seq_sth->fetchrow_arrayref->[0];
 753
 754       # don't drink soap!  recurse!  recurse!  okay!
 755       my $error =
 756         _copy_skel( $child_table_def,
 757                     $row->{$child_pkey}, #sourceid
 758                     $insertid, #destid
 759                     %{ $child_tables{$child_table_def} },
 760                   );
 761       return $error if $error;
 762
 763     }
 764
 765   }
 766
 767   return '';
 768
 769 }
 770
 771 =item order_pkg HASHREF | OPTION => VALUE ...
 772
 773 Orders a single package.
 774
 775 Options may be passed as a list of key/value pairs or as a hash reference.
 776 Options are:
 777
 778 =over 4
 779
 780 =item cust_pkg
 781
 782 FS::cust_pkg object
 783
 784 =item cust_location
 785
 786 Optional FS::cust_location object
 787
 788 =item svcs
 789
 790 Optional arryaref of FS::svc_* service objects.
 791
 792 =item depend_jobnum
 793
 794 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
 795 jobs will have a dependancy on the supplied job (they will not run until the
 796 specific job completes).  This can be used to defer provisioning until some
 797 action completes (such as running the customer's credit card successfully).
 798
 799 =item ticket_subject
 800
 801 Optional subject for a ticket created and attached to this customer
 802
 803 =item ticket_subject
 804
 805 Optional queue name for ticket additions
 806
 807 =back
 808
 809 =cut
 810
 811 sub order_pkg {
 812   my $self = shift;
 813   my $opt = ref($_[0]) ? shift : { @_ };
 814
 815   warn "$me order_pkg called with options ".
 816        join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
 817     if $DEBUG;
 818
 819   my $cust_pkg = $opt->{'cust_pkg'};
 820   my $svcs     = $opt->{'svcs'} || [];
 821
 822   my %svc_options = ();
 823   $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
 824     if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
 825
 826   my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
 827                           qw( ticket_subject ticket_queue );
 828
 829   local $SIG{HUP} = 'IGNORE';
 830   local $SIG{INT} = 'IGNORE';
 831   local $SIG{QUIT} = 'IGNORE';
 832   local $SIG{TERM} = 'IGNORE';
 833   local $SIG{TSTP} = 'IGNORE';
 834   local $SIG{PIPE} = 'IGNORE';
 835
 836   my $oldAutoCommit = $FS::UID::AutoCommit;
 837   local $FS::UID::AutoCommit = 0;
 838   my $dbh = dbh;
 839
 840   if ( $opt->{'cust_location'} &&
 841        ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
 842     my $error = $opt->{'cust_location'}->insert;
 843     if ( $error ) {
 844       $dbh->rollback if $oldAutoCommit;
 845       return "inserting cust_location (transaction rolled back): $error";
 846     }
 847     $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
 848   }
 849
 850   $cust_pkg->custnum( $self->custnum );
 851
 852   my $error = $cust_pkg->insert( %insert_params );
 853   if ( $error ) {
 854     $dbh->rollback if $oldAutoCommit;
 855     return "inserting cust_pkg (transaction rolled back): $error";
 856   }
 857
 858   foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
 859     if ( $svc_something->svcnum ) {
 860       my $old_cust_svc = $svc_something->cust_svc;
 861       my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 862       $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
 863       $error = $new_cust_svc->replace($old_cust_svc);
 864     } else {
 865       $svc_something->pkgnum( $cust_pkg->pkgnum );
 866       if ( $svc_something->isa('FS::svc_acct') ) {
 867         foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
 868                        qw( seconds upbytes downbytes totalbytes )      ) {
 869           $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
 870           ${ $opt->{$_.'_ref'} } = 0;
 871         }
 872       }
 873       $error = $svc_something->insert(%svc_options);
 874     }
 875     if ( $error ) {
 876       $dbh->rollback if $oldAutoCommit;
 877       return "inserting svc_ (transaction rolled back): $error";
 878     }
 879   }
 880
 881   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 882   ''; #no error
 883
 884 }
 885
 886 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
 887 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
 888
 889 Like the insert method on an existing record, this method orders multiple
 890 packages and included services atomicaly.  Pass a Tie::RefHash data structure
 891 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
 892 There should be a better explanation of this, but until then, here's an
 893 example:
 894
 895   use Tie::RefHash;
 896   tie %hash, 'Tie::RefHash'; #this part is important
 897   %hash = (
 898     $cust_pkg => [ $svc_acct ],
 899     ...
 900   );
 901   $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
 902
 903 Services can be new, in which case they are inserted, or existing unaudited
 904 services, in which case they are linked to the newly-created package.
 905
 906 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
 907 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
 908
 909 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 910 on the supplied jobnum (they will not run until the specific job completes).
 911 This can be used to defer provisioning until some action completes (such
 912 as running the customer's credit card successfully).
 913
 914 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 915 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 916 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 917 on the cust_main object is not recommended, as existing services will also be
 918 reexported.)
 919
 920 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
 921 provided, the scalars (provided by references) will be incremented by the
 922 values of the prepaid card.`
 923
 924 =cut
 925
 926 sub order_pkgs {
 927   my $self = shift;
 928   my $cust_pkgs = shift;
 929   my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
 930   my %options = @_;
 931   $seconds_ref ||= $options{'seconds_ref'};
 932
 933   warn "$me order_pkgs called with options ".
 934        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 935     if $DEBUG;
 936
 937   local $SIG{HUP} = 'IGNORE';
 938   local $SIG{INT} = 'IGNORE';
 939   local $SIG{QUIT} = 'IGNORE';
 940   local $SIG{TERM} = 'IGNORE';
 941   local $SIG{TSTP} = 'IGNORE';
 942   local $SIG{PIPE} = 'IGNORE';
 943
 944   my $oldAutoCommit = $FS::UID::AutoCommit;
 945   local $FS::UID::AutoCommit = 0;
 946   my $dbh = dbh;
 947
 948   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 949
 950   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 951
 952     my $error = $self->order_pkg(
 953       'cust_pkg'     => $cust_pkg,
 954       'svcs'         => $cust_pkgs->{$cust_pkg},
 955       'seconds_ref'  => $seconds_ref,
 956       map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
 957                                      depend_jobnum
 958                                    )
 959     );
 960     if ( $error ) {
 961       $dbh->rollback if $oldAutoCommit;
 962       return $error;
 963     }
 964
 965   }
 966
 967   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 968   ''; #no error
 969 }
 970
 971 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
 972
 973 Recharges this (existing) customer with the specified prepaid card (see
 974 L<FS::prepay_credit>), specified either by I<identifier> or as an
 975 FS::prepay_credit object.  If there is an error, returns the error, otherwise
 976 returns false.
 977
 978 Optionally, five scalar references can be passed as well.  They will have their
 979 values filled in with the amount, number of seconds, and number of upload,
 980 download, and total bytes applied by this prepaid card.
 981
 982 =cut
 983
 984 #the ref bullshit here should be refactored like get_prepay.  MyAccount.pm is
 985 #the only place that uses these args
 986 sub recharge_prepay {
 987   my( $self, $prepay_credit, $amountref, $secondsref,
 988       $upbytesref, $downbytesref, $totalbytesref ) = @_;
 989
 990   local $SIG{HUP} = 'IGNORE';
 991   local $SIG{INT} = 'IGNORE';
 992   local $SIG{QUIT} = 'IGNORE';
 993   local $SIG{TERM} = 'IGNORE';
 994   local $SIG{TSTP} = 'IGNORE';
 995   local $SIG{PIPE} = 'IGNORE';
 996
 997   my $oldAutoCommit = $FS::UID::AutoCommit;
 998   local $FS::UID::AutoCommit = 0;
 999   my $dbh = dbh;
1000
1001   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
1002
1003   my $error = $self->get_prepay( $prepay_credit,
1004                                  'amount_ref'     => \$amount,
1005                                  'seconds_ref'    => \$seconds,
1006                                  'upbytes_ref'    => \$upbytes,
1007                                  'downbytes_ref'  => \$downbytes,
1008                                  'totalbytes_ref' => \$totalbytes,
1009                                )
1010            || $self->increment_seconds($seconds)
1011            || $self->increment_upbytes($upbytes)
1012            || $self->increment_downbytes($downbytes)
1013            || $self->increment_totalbytes($totalbytes)
1014            || $self->insert_cust_pay_prepay( $amount,
1015                                              ref($prepay_credit)
1016                                                ? $prepay_credit->identifier
1017                                                : $prepay_credit
1018                                            );
1019
1020   if ( $error ) {
1021     $dbh->rollback if $oldAutoCommit;
1022     return $error;
1023   }
1024
1025   if ( defined($amountref)  ) { $$amountref  = $amount;  }
1026   if ( defined($secondsref) ) { $$secondsref = $seconds; }
1027   if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
1028   if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
1029   if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
1030
1031   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1032   '';
1033
1034 }
1035
1036 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
1037
1038 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
1039 specified either by I<identifier> or as an FS::prepay_credit object.
1040
1041 Available options are: I<amount_ref>, I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.  The scalars (provided by references) will be
1042 incremented by the values of the prepaid card.
1043
1044 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
1045 check or set this customer's I<agentnum>.
1046
1047 If there is an error, returns the error, otherwise returns false.
1048
1049 =cut
1050
1051
1052 sub get_prepay {
1053   my( $self, $prepay_credit, %opt ) = @_;
1054
1055   local $SIG{HUP} = 'IGNORE';
1056   local $SIG{INT} = 'IGNORE';
1057   local $SIG{QUIT} = 'IGNORE';
1058   local $SIG{TERM} = 'IGNORE';
1059   local $SIG{TSTP} = 'IGNORE';
1060   local $SIG{PIPE} = 'IGNORE';
1061
1062   my $oldAutoCommit = $FS::UID::AutoCommit;
1063   local $FS::UID::AutoCommit = 0;
1064   my $dbh = dbh;
1065
1066   unless ( ref($prepay_credit) ) {
1067
1068     my $identifier = $prepay_credit;
1069
1070     $prepay_credit = qsearchs(
1071       'prepay_credit',
1072       { 'identifier' => $prepay_credit },
1073       '',
1074       'FOR UPDATE'
1075     );
1076
1077     unless ( $prepay_credit ) {
1078       $dbh->rollback if $oldAutoCommit;
1079       return "Invalid prepaid card: ". $identifier;
1080     }
1081
1082   }
1083
1084   if ( $prepay_credit->agentnum ) {
1085     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1086       $dbh->rollback if $oldAutoCommit;
1087       return "prepaid card not valid for agent ". $self->agentnum;
1088     }
1089     $self->agentnum($prepay_credit->agentnum);
1090   }
1091
1092   my $error = $prepay_credit->delete;
1093   if ( $error ) {
1094     $dbh->rollback if $oldAutoCommit;
1095     return "removing prepay_credit (transaction rolled back): $error";
1096   }
1097
1098   ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1099     for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1100
1101   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1102   '';
1103
1104 }
1105
1106 =item increment_upbytes SECONDS
1107
1108 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1109 the specified number of upbytes.  If there is an error, returns the error,
1110 otherwise returns false.
1111
1112 =cut
1113
1114 sub increment_upbytes {
1115   _increment_column( shift, 'upbytes', @_);
1116 }
1117
1118 =item increment_downbytes SECONDS
1119
1120 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1121 the specified number of downbytes.  If there is an error, returns the error,
1122 otherwise returns false.
1123
1124 =cut
1125
1126 sub increment_downbytes {
1127   _increment_column( shift, 'downbytes', @_);
1128 }
1129
1130 =item increment_totalbytes SECONDS
1131
1132 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1133 the specified number of totalbytes.  If there is an error, returns the error,
1134 otherwise returns false.
1135
1136 =cut
1137
1138 sub increment_totalbytes {
1139   _increment_column( shift, 'totalbytes', @_);
1140 }
1141
1142 =item increment_seconds SECONDS
1143
1144 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1145 the specified number of seconds.  If there is an error, returns the error,
1146 otherwise returns false.
1147
1148 =cut
1149
1150 sub increment_seconds {
1151   _increment_column( shift, 'seconds', @_);
1152 }
1153
1154 =item _increment_column AMOUNT
1155
1156 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1157 the specified number of seconds or bytes.  If there is an error, returns
1158 the error, otherwise returns false.
1159
1160 =cut
1161
1162 sub _increment_column {
1163   my( $self, $column, $amount ) = @_;
1164   warn "$me increment_column called: $column, $amount\n"
1165     if $DEBUG;
1166
1167   return '' unless $amount;
1168
1169   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1170                       $self->ncancelled_pkgs;
1171
1172   if ( ! @cust_pkg ) {
1173     return 'No packages with primary or single services found'.
1174            ' to apply pre-paid time';
1175   } elsif ( scalar(@cust_pkg) > 1 ) {
1176     #maybe have a way to specify the package/account?
1177     return 'Multiple packages found to apply pre-paid time';
1178   }
1179
1180   my $cust_pkg = $cust_pkg[0];
1181   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
1182     if $DEBUG > 1;
1183
1184   my @cust_svc =
1185     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1186
1187   if ( ! @cust_svc ) {
1188     return 'No account found to apply pre-paid time';
1189   } elsif ( scalar(@cust_svc) > 1 ) {
1190     return 'Multiple accounts found to apply pre-paid time';
1191   }
1192
1193   my $svc_acct = $cust_svc[0]->svc_x;
1194   warn "  found service svcnum ". $svc_acct->pkgnum.
1195        ' ('. $svc_acct->email. ")\n"
1196     if $DEBUG > 1;
1197
1198   $column = "increment_$column";
1199   $svc_acct->$column($amount);
1200
1201 }
1202
1203 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1204
1205 Inserts a prepayment in the specified amount for this customer.  An optional
1206 second argument can specify the prepayment identifier for tracking purposes.
1207 If there is an error, returns the error, otherwise returns false.
1208
1209 =cut
1210
1211 sub insert_cust_pay_prepay {
1212   shift->insert_cust_pay('PREP', @_);
1213 }
1214
1215 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1216
1217 Inserts a cash payment in the specified amount for this customer.  An optional
1218 second argument can specify the payment identifier for tracking purposes.
1219 If there is an error, returns the error, otherwise returns false.
1220
1221 =cut
1222
1223 sub insert_cust_pay_cash {
1224   shift->insert_cust_pay('CASH', @_);
1225 }
1226
1227 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1228
1229 Inserts a Western Union payment in the specified amount for this customer.  An
1230 optional second argument can specify the prepayment identifier for tracking
1231 purposes.  If there is an error, returns the error, otherwise returns false.
1232
1233 =cut
1234
1235 sub insert_cust_pay_west {
1236   shift->insert_cust_pay('WEST', @_);
1237 }
1238
1239 sub insert_cust_pay {
1240   my( $self, $payby, $amount ) = splice(@_, 0, 3);
1241   my $payinfo = scalar(@_) ? shift : '';
1242
1243   my $cust_pay = new FS::cust_pay {
1244     'custnum' => $self->custnum,
1245     'paid'    => sprintf('%.2f', $amount),
1246     #'_date'   => #date the prepaid card was purchased???
1247     'payby'   => $payby,
1248     'payinfo' => $payinfo,
1249   };
1250   $cust_pay->insert;
1251
1252 }
1253
1254 =item reexport
1255
1256 This method is deprecated.  See the I<depend_jobnum> option to the insert and
1257 order_pkgs methods for a better way to defer provisioning.
1258
1259 Re-schedules all exports by calling the B<reexport> method of all associated
1260 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
1261 otherwise returns false.
1262
1263 =cut
1264
1265 sub reexport {
1266   my $self = shift;
1267
1268   carp "WARNING: FS::cust_main::reexport is deprectated; ".
1269        "use the depend_jobnum option to insert or order_pkgs to delay export";
1270
1271   local $SIG{HUP} = 'IGNORE';
1272   local $SIG{INT} = 'IGNORE';
1273   local $SIG{QUIT} = 'IGNORE';
1274   local $SIG{TERM} = 'IGNORE';
1275   local $SIG{TSTP} = 'IGNORE';
1276   local $SIG{PIPE} = 'IGNORE';
1277
1278   my $oldAutoCommit = $FS::UID::AutoCommit;
1279   local $FS::UID::AutoCommit = 0;
1280   my $dbh = dbh;
1281
1282   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1283     my $error = $cust_pkg->reexport;
1284     if ( $error ) {
1285       $dbh->rollback if $oldAutoCommit;
1286       return $error;
1287     }
1288   }
1289
1290   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1291   '';
1292
1293 }
1294
1295 =item delete [ OPTION => VALUE ... ]
1296
1297 This deletes the customer.  If there is an error, returns the error, otherwise
1298 returns false.
1299
1300 This will completely remove all traces of the customer record.  This is not
1301 what you want when a customer cancels service; for that, cancel all of the
1302 customer's packages (see L</cancel>).
1303
1304 If the customer has any uncancelled packages, you need to pass a new (valid)
1305 customer number for those packages to be transferred to, as the "new_customer"
1306 option.  Cancelled packages will be deleted.  Did I mention that this is NOT
1307 what you want when a customer cancels service and that you really should be
1308 looking at L<FS::cust_pkg/cancel>?
1309
1310 You can't delete a customer with invoices (see L<FS::cust_bill>),
1311 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1312 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1313 set the "delete_financials" option to a true value.
1314
1315 =cut
1316
1317 sub delete {
1318   my( $self, %opt ) = @_;
1319
1320   local $SIG{HUP} = 'IGNORE';
1321   local $SIG{INT} = 'IGNORE';
1322   local $SIG{QUIT} = 'IGNORE';
1323   local $SIG{TERM} = 'IGNORE';
1324   local $SIG{TSTP} = 'IGNORE';
1325   local $SIG{PIPE} = 'IGNORE';
1326
1327   my $oldAutoCommit = $FS::UID::AutoCommit;
1328   local $FS::UID::AutoCommit = 0;
1329   my $dbh = dbh;
1330
1331   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1332      $dbh->rollback if $oldAutoCommit;
1333      return "Can't delete a master agent customer";
1334   }
1335
1336   #use FS::access_user
1337   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1338      $dbh->rollback if $oldAutoCommit;
1339      return "Can't delete a master employee customer";
1340   }
1341
1342   tie my %financial_tables, 'Tie::IxHash',
1343     'cust_bill'      => 'invoices',
1344     'cust_statement' => 'statements',
1345     'cust_credit'    => 'credits',
1346     'cust_pay'       => 'payments',
1347     'cust_refund'    => 'refunds',
1348   ;
1349
1350   foreach my $table ( keys %financial_tables ) {
1351
1352     my @records = $self->$table();
1353
1354     if ( @records && ! $opt{'delete_financials'} ) {
1355       $dbh->rollback if $oldAutoCommit;
1356       return "Can't delete a customer with ". $financial_tables{$table};
1357     }
1358
1359     foreach my $record ( @records ) {
1360       my $error = $record->delete;
1361       if ( $error ) {
1362         $dbh->rollback if $oldAutoCommit;
1363         return "Error deleting ". $financial_tables{$table}. ": $error\n";
1364       }
1365     }
1366
1367   }
1368
1369   my @cust_pkg = $self->ncancelled_pkgs;
1370   if ( @cust_pkg ) {
1371     my $new_custnum = $opt{'new_custnum'};
1372     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1373       $dbh->rollback if $oldAutoCommit;
1374       return "Invalid new customer number: $new_custnum";
1375     }
1376     foreach my $cust_pkg ( @cust_pkg ) {
1377       my %hash = $cust_pkg->hash;
1378       $hash{'custnum'} = $new_custnum;
1379       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1380       my $error = $new_cust_pkg->replace($cust_pkg,
1381                                          options => { $cust_pkg->options },
1382                                         );
1383       if ( $error ) {
1384         $dbh->rollback if $oldAutoCommit;
1385         return $error;
1386       }
1387     }
1388   }
1389   my @cancelled_cust_pkg = $self->all_pkgs;
1390   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1391     my $error = $cust_pkg->delete;
1392     if ( $error ) {
1393       $dbh->rollback if $oldAutoCommit;
1394       return $error;
1395     }
1396   }
1397
1398   #cust_tax_adjustment in financials?
1399   #cust_pay_pending?  ouch
1400   #cust_recon?
1401   foreach my $table (qw(
1402     cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1403     cust_location cust_main_note cust_tax_adjustment
1404     cust_pay_void cust_pay_batch queue cust_tax_exempt
1405   )) {
1406     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1407       my $error = $record->delete;
1408       if ( $error ) {
1409         $dbh->rollback if $oldAutoCommit;
1410         return $error;
1411       }
1412     }
1413   }
1414
1415   my $sth = $dbh->prepare(
1416     'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1417   ) or do {
1418     my $errstr = $dbh->errstr;
1419     $dbh->rollback if $oldAutoCommit;
1420     return $errstr;
1421   };
1422   $sth->execute($self->custnum) or do {
1423     my $errstr = $sth->errstr;
1424     $dbh->rollback if $oldAutoCommit;
1425     return $errstr;
1426   };
1427
1428   #tickets
1429
1430   my $ticket_dbh = '';
1431   if ($conf->config('ticket_system') eq 'RT_Internal') {
1432     $ticket_dbh = $dbh;
1433   } elsif ($conf->config('ticket_system') eq 'RT_External') {
1434     my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1435     $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1436       #or die "RT_External DBI->connect error: $DBI::errstr\n";
1437   }
1438
1439   if ( $ticket_dbh ) {
1440
1441     my $ticket_sth = $ticket_dbh->prepare(
1442       'DELETE FROM Links WHERE Target = ?'
1443     ) or do {
1444       my $errstr = $ticket_dbh->errstr;
1445       $dbh->rollback if $oldAutoCommit;
1446       return $errstr;
1447     };
1448     $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1449       or do {
1450         my $errstr = $ticket_sth->errstr;
1451         $dbh->rollback if $oldAutoCommit;
1452         return $errstr;
1453       };
1454
1455     #check and see if the customer is the only link on the ticket, and
1456     #if so, set the ticket to deleted status in RT?
1457     #maybe someday, for now this will at least fix tickets not displaying
1458
1459   }
1460
1461   #delete the customer record
1462
1463   my $error = $self->SUPER::delete;
1464   if ( $error ) {
1465     $dbh->rollback if $oldAutoCommit;
1466     return $error;
1467   }
1468
1469   # cust_main exports!
1470
1471   #my $export_args = $options{'export_args'} || [];
1472
1473   my @part_export =
1474     map qsearch( 'part_export', {exportnum=>$_} ),
1475       $conf->config('cust_main-exports'); #, $agentnum
1476
1477   foreach my $part_export ( @part_export ) {
1478     my $error = $part_export->export_delete( $self ); #, @$export_args);
1479     if ( $error ) {
1480       $dbh->rollback if $oldAutoCommit;
1481       return "exporting to ". $part_export->exporttype.
1482              " (transaction rolled back): $error";
1483     }
1484   }
1485
1486   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1487   '';
1488
1489 }
1490
1491 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1492
1493
1494 Replaces the OLD_RECORD with this one in the database.  If there is an error,
1495 returns the error, otherwise returns false.
1496
1497 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1498 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
1499 expected and rollback the entire transaction; it is not necessary to call
1500 check_invoicing_list first.  Here's an example:
1501
1502   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1503
1504 Currently available options are: I<tax_exemption>.
1505
1506 The I<tax_exemption> option can be set to an arrayref of tax names.
1507 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1508
1509 =cut
1510
1511 sub replace {
1512   my $self = shift;
1513
1514   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1515               ? shift
1516               : $self->replace_old;
1517
1518   my @param = @_;
1519
1520   warn "$me replace called\n"
1521     if $DEBUG;
1522
1523   my $curuser = $FS::CurrentUser::CurrentUser;
1524   if (    $self->payby eq 'COMP'
1525        && $self->payby ne $old->payby
1526        && ! $curuser->access_right('Complimentary customer')
1527      )
1528   {
1529     return "You are not permitted to create complimentary accounts.";
1530   }
1531
1532   local($ignore_expired_card) = 1
1533     if $old->payby  =~ /^(CARD|DCRD)$/
1534     && $self->payby =~ /^(CARD|DCRD)$/
1535     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1536
1537   local $SIG{HUP} = 'IGNORE';
1538   local $SIG{INT} = 'IGNORE';
1539   local $SIG{QUIT} = 'IGNORE';
1540   local $SIG{TERM} = 'IGNORE';
1541   local $SIG{TSTP} = 'IGNORE';
1542   local $SIG{PIPE} = 'IGNORE';
1543
1544   my $oldAutoCommit = $FS::UID::AutoCommit;
1545   local $FS::UID::AutoCommit = 0;
1546   my $dbh = dbh;
1547
1548   my $error = $self->SUPER::replace($old);
1549
1550   if ( $error ) {
1551     $dbh->rollback if $oldAutoCommit;
1552     return $error;
1553   }
1554
1555   if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1556     my $invoicing_list = shift @param;
1557     $error = $self->check_invoicing_list( $invoicing_list );
1558     if ( $error ) {
1559       $dbh->rollback if $oldAutoCommit;
1560       return $error;
1561     }
1562     $self->invoicing_list( $invoicing_list );
1563   }
1564
1565   if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1566
1567     #this could be more efficient than deleting and re-inserting, if it matters
1568     foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1569       my $error = $cust_tag->delete;
1570       if ( $error ) {
1571         $dbh->rollback if $oldAutoCommit;
1572         return $error;
1573       }
1574     }
1575     foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1576       my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
1577                                         'custnum' => $self->custnum };
1578       my $error = $cust_tag->insert;
1579       if ( $error ) {
1580         $dbh->rollback if $oldAutoCommit;
1581         return $error;
1582       }
1583     }
1584
1585   }
1586
1587   my %options = @param;
1588
1589   my $tax_exemption = delete $options{'tax_exemption'};
1590   if ( $tax_exemption ) {
1591
1592     my %cust_main_exemption =
1593       map { $_->taxname => $_ }
1594           qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1595
1596     foreach my $taxname ( @$tax_exemption ) {
1597
1598       next if delete $cust_main_exemption{$taxname};
1599
1600       my $cust_main_exemption = new FS::cust_main_exemption {
1601         'custnum' => $self->custnum,
1602         'taxname' => $taxname,
1603       };
1604       my $error = $cust_main_exemption->insert;
1605       if ( $error ) {
1606         $dbh->rollback if $oldAutoCommit;
1607         return "inserting cust_main_exemption (transaction rolled back): $error";
1608       }
1609     }
1610
1611     foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1612       my $error = $cust_main_exemption->delete;
1613       if ( $error ) {
1614         $dbh->rollback if $oldAutoCommit;
1615         return "deleting cust_main_exemption (transaction rolled back): $error";
1616       }
1617     }
1618
1619   }
1620
1621   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1622        && ( ( $self->get('payinfo') ne $old->get('payinfo')
1623               && $self->get('payinfo') !~ /^99\d{14}$/
1624             )
1625             || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1626           )
1627      )
1628   {
1629
1630     # card/check/lec info has changed, want to retry realtime_ invoice events
1631     my $error = $self->retry_realtime;
1632     if ( $error ) {
1633       $dbh->rollback if $oldAutoCommit;
1634       return $error;
1635     }
1636   }
1637
1638   unless ( $import || $skip_fuzzyfiles ) {
1639     $error = $self->queue_fuzzyfiles_update;
1640     if ( $error ) {
1641       $dbh->rollback if $oldAutoCommit;
1642       return "updating fuzzy search cache: $error";
1643     }
1644   }
1645
1646   # cust_main exports!
1647
1648   my $export_args = $options{'export_args'} || [];
1649
1650   my @part_export =
1651     map qsearch( 'part_export', {exportnum=>$_} ),
1652       $conf->config('cust_main-exports'); #, $agentnum
1653
1654   foreach my $part_export ( @part_export ) {
1655     my $error = $part_export->export_replace( $self, $old, @$export_args);
1656     if ( $error ) {
1657       $dbh->rollback if $oldAutoCommit;
1658       return "exporting to ". $part_export->exporttype.
1659              " (transaction rolled back): $error";
1660     }
1661   }
1662
1663   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1664   '';
1665
1666 }
1667
1668 =item queue_fuzzyfiles_update
1669
1670 Used by insert & replace to update the fuzzy search cache
1671
1672 =cut
1673
1674 sub queue_fuzzyfiles_update {
1675   my $self = shift;
1676
1677   local $SIG{HUP} = 'IGNORE';
1678   local $SIG{INT} = 'IGNORE';
1679   local $SIG{QUIT} = 'IGNORE';
1680   local $SIG{TERM} = 'IGNORE';
1681   local $SIG{TSTP} = 'IGNORE';
1682   local $SIG{PIPE} = 'IGNORE';
1683
1684   my $oldAutoCommit = $FS::UID::AutoCommit;
1685   local $FS::UID::AutoCommit = 0;
1686   my $dbh = dbh;
1687
1688   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1689   my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1690   if ( $error ) {
1691     $dbh->rollback if $oldAutoCommit;
1692     return "queueing job (transaction rolled back): $error";
1693   }
1694
1695   if ( $self->ship_last ) {
1696     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1697     $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1698     if ( $error ) {
1699       $dbh->rollback if $oldAutoCommit;
1700       return "queueing job (transaction rolled back): $error";
1701     }
1702   }
1703
1704   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1705   '';
1706
1707 }
1708
1709 =item check
1710
1711 Checks all fields to make sure this is a valid customer record.  If there is
1712 an error, returns the error, otherwise returns false.  Called by the insert
1713 and replace methods.
1714
1715 =cut
1716
1717 sub check {
1718   my $self = shift;
1719
1720   warn "$me check BEFORE: \n". $self->_dump
1721     if $DEBUG > 2;
1722
1723   my $error =
1724     $self->ut_numbern('custnum')
1725     || $self->ut_number('agentnum')
1726     || $self->ut_textn('agent_custid')
1727     || $self->ut_number('refnum')
1728     || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1729     || $self->ut_textn('custbatch')
1730     || $self->ut_name('last')
1731     || $self->ut_name('first')
1732     || $self->ut_snumbern('birthdate')
1733     || $self->ut_snumbern('signupdate')
1734     || $self->ut_textn('company')
1735     || $self->ut_text('address1')
1736     || $self->ut_textn('address2')
1737     || $self->ut_text('city')
1738     || $self->ut_textn('county')
1739     || $self->ut_textn('state')
1740     || $self->ut_country('country')
1741     || $self->ut_anything('comments')
1742     || $self->ut_numbern('referral_custnum')
1743     || $self->ut_textn('stateid')
1744     || $self->ut_textn('stateid_state')
1745     || $self->ut_textn('invoice_terms')
1746     || $self->ut_alphan('geocode')
1747     || $self->ut_floatn('cdr_termination_percentage')
1748   ;
1749
1750   #barf.  need message catalogs.  i18n.  etc.
1751   $error .= "Please select an advertising source."
1752     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1753   return $error if $error;
1754
1755   return "Unknown agent"
1756     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1757
1758   return "Unknown refnum"
1759     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1760
1761   return "Unknown referring custnum: ". $self->referral_custnum
1762     unless ! $self->referral_custnum
1763            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1764
1765   if ( $self->censustract ne '' ) {
1766     $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1767       or return "Illegal census tract: ". $self->censustract;
1768
1769     $self->censustract("$1.$2");
1770   }
1771
1772   if ( $self->ss eq '' ) {
1773     $self->ss('');
1774   } else {
1775     my $ss = $self->ss;
1776     $ss =~ s/\D//g;
1777     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1778       or return "Illegal social security number: ". $self->ss;
1779     $self->ss("$1-$2-$3");
1780   }
1781
1782
1783 # bad idea to disable, causes billing to fail because of no tax rates later
1784 # except we don't fail any more
1785   unless ( $import ) {
1786     unless ( qsearch('cust_main_county', {
1787       'country' => $self->country,
1788       'state'   => '',
1789      } ) ) {
1790       return "Unknown state/county/country: ".
1791         $self->state. "/". $self->county. "/". $self->country
1792         unless qsearch('cust_main_county',{
1793           'state'   => $self->state,
1794           'county'  => $self->county,
1795           'country' => $self->country,
1796         } );
1797     }
1798   }
1799
1800   $error =
1801     $self->ut_phonen('daytime', $self->country)
1802     || $self->ut_phonen('night', $self->country)
1803     || $self->ut_phonen('fax', $self->country)
1804   ;
1805   return $error if $error;
1806
1807   unless ( $ignore_illegal_zip ) {
1808     $error = $self->ut_zip('zip', $self->country);
1809     return $error if $error;
1810   }
1811
1812   if ( $conf->exists('cust_main-require_phone')
1813        && ! length($self->daytime) && ! length($self->night)
1814      ) {
1815
1816     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1817                           ? 'Day Phone'
1818                           : FS::Msgcat::_gettext('daytime');
1819     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1820                         ? 'Night Phone'
1821                         : FS::Msgcat::_gettext('night');
1822
1823     return "$daytime_label or $night_label is required"
1824
1825   }
1826
1827   if ( $self->has_ship_address
1828        && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1829                         $self->addr_fields )
1830      )
1831   {
1832     my $error =
1833       $self->ut_name('ship_last')
1834       || $self->ut_name('ship_first')
1835       || $self->ut_textn('ship_company')
1836       || $self->ut_text('ship_address1')
1837       || $self->ut_textn('ship_address2')
1838       || $self->ut_text('ship_city')
1839       || $self->ut_textn('ship_county')
1840       || $self->ut_textn('ship_state')
1841       || $self->ut_country('ship_country')
1842     ;
1843     return $error if $error;
1844
1845     #false laziness with above
1846     unless ( qsearchs('cust_main_county', {
1847       'country' => $self->ship_country,
1848       'state'   => '',
1849      } ) ) {
1850       return "Unknown ship_state/ship_county/ship_country: ".
1851         $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1852         unless qsearch('cust_main_county',{
1853           'state'   => $self->ship_state,
1854           'county'  => $self->ship_county,
1855           'country' => $self->ship_country,
1856         } );
1857     }
1858     #eofalse
1859
1860     $error =
1861       $self->ut_phonen('ship_daytime', $self->ship_country)
1862       || $self->ut_phonen('ship_night', $self->ship_country)
1863       || $self->ut_phonen('ship_fax', $self->ship_country)
1864     ;
1865     return $error if $error;
1866
1867     unless ( $ignore_illegal_zip ) {
1868       $error = $self->ut_zip('ship_zip', $self->ship_country);
1869       return $error if $error;
1870     }
1871     return "Unit # is required."
1872       if $self->ship_address2 =~ /^\s*$/
1873       && $conf->exists('cust_main-require_address2');
1874
1875   } else { # ship_ info eq billing info, so don't store dup info in database
1876
1877     $self->setfield("ship_$_", '')
1878       foreach $self->addr_fields;
1879
1880     return "Unit # is required."
1881       if $self->address2 =~ /^\s*$/
1882       && $conf->exists('cust_main-require_address2');
1883
1884   }
1885
1886   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1887   #  or return "Illegal payby: ". $self->payby;
1888   #$self->payby($1);
1889   FS::payby->can_payby($self->table, $self->payby)
1890     or return "Illegal payby: ". $self->payby;
1891
1892   $error =    $self->ut_numbern('paystart_month')
1893            || $self->ut_numbern('paystart_year')
1894            || $self->ut_numbern('payissue')
1895            || $self->ut_textn('paytype')
1896   ;
1897   return $error if $error;
1898
1899   if ( $self->payip eq '' ) {
1900     $self->payip('');
1901   } else {
1902     $error = $self->ut_ip('payip');
1903     return $error if $error;
1904   }
1905
1906   # If it is encrypted and the private key is not availaible then we can't
1907   # check the credit card.
1908   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1909
1910   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1911
1912     my $payinfo = $self->payinfo;
1913     $payinfo =~ s/\D//g;
1914     $payinfo =~ /^(\d{13,16})$/
1915       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1916     $payinfo = $1;
1917     $self->payinfo($payinfo);
1918     validate($payinfo)
1919       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1920
1921     return gettext('unknown_card_type')
1922       if $self->payinfo !~ /^99\d{14}$/ #token
1923       && cardtype($self->payinfo) eq "Unknown";
1924
1925     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1926     if ( $ban ) {
1927       return 'Banned credit card: banned on '.
1928              time2str('%a %h %o at %r', $ban->_date).
1929              ' by '. $ban->otaker.
1930              ' (ban# '. $ban->bannum. ')';
1931     }
1932
1933     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1934       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1935         $self->paycvv =~ /^(\d{4})$/
1936           or return "CVV2 (CID) for American Express cards is four digits.";
1937         $self->paycvv($1);
1938       } else {
1939         $self->paycvv =~ /^(\d{3})$/
1940           or return "CVV2 (CVC2/CID) is three digits.";
1941         $self->paycvv($1);
1942       }
1943     } else {
1944       $self->paycvv('');
1945     }
1946
1947     my $cardtype = cardtype($payinfo);
1948     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1949
1950       return "Start date or issue number is required for $cardtype cards"
1951         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1952
1953       return "Start month must be between 1 and 12"
1954         if $self->paystart_month
1955            and $self->paystart_month < 1 || $self->paystart_month > 12;
1956
1957       return "Start year must be 1990 or later"
1958         if $self->paystart_year
1959            and $self->paystart_year < 1990;
1960
1961       return "Issue number must be beween 1 and 99"
1962         if $self->payissue
1963           and $self->payissue < 1 || $self->payissue > 99;
1964
1965     } else {
1966       $self->paystart_month('');
1967       $self->paystart_year('');
1968       $self->payissue('');
1969     }
1970
1971   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1972
1973     my $payinfo = $self->payinfo;
1974     $payinfo =~ s/[^\d\@]//g;
1975     if ( $conf->exists('echeck-nonus') ) {
1976       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1977       $payinfo = "$1\@$2";
1978     } else {
1979       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1980       $payinfo = "$1\@$2";
1981     }
1982     $self->payinfo($payinfo);
1983     $self->paycvv('');
1984
1985     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1986     if ( $ban ) {
1987       return 'Banned ACH account: banned on '.
1988              time2str('%a %h %o at %r', $ban->_date).
1989              ' by '. $ban->otaker.
1990              ' (ban# '. $ban->bannum. ')';
1991     }
1992
1993   } elsif ( $self->payby eq 'LECB' ) {
1994
1995     my $payinfo = $self->payinfo;
1996     $payinfo =~ s/\D//g;
1997     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1998     $payinfo = $1;
1999     $self->payinfo($payinfo);
2000     $self->paycvv('');
2001
2002   } elsif ( $self->payby eq 'BILL' ) {
2003
2004     $error = $self->ut_textn('payinfo');
2005     return "Illegal P.O. number: ". $self->payinfo if $error;
2006     $self->paycvv('');
2007
2008   } elsif ( $self->payby eq 'COMP' ) {
2009
2010     my $curuser = $FS::CurrentUser::CurrentUser;
2011     if (    ! $self->custnum
2012          && ! $curuser->access_right('Complimentary customer')
2013        )
2014     {
2015       return "You are not permitted to create complimentary accounts."
2016     }
2017
2018     $error = $self->ut_textn('payinfo');
2019     return "Illegal comp account issuer: ". $self->payinfo if $error;
2020     $self->paycvv('');
2021
2022   } elsif ( $self->payby eq 'PREPAY' ) {
2023
2024     my $payinfo = $self->payinfo;
2025     $payinfo =~ s/\W//g; #anything else would just confuse things
2026     $self->payinfo($payinfo);
2027     $error = $self->ut_alpha('payinfo');
2028     return "Illegal prepayment identifier: ". $self->payinfo if $error;
2029     return "Unknown prepayment identifier"
2030       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2031     $self->paycvv('');
2032
2033   }
2034
2035   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2036     return "Expiration date required"
2037       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
2038     $self->paydate('');
2039   } else {
2040     my( $m, $y );
2041     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2042       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2043     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2044       ( $m, $y ) = ( $2, "19$1" );
2045     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2046       ( $m, $y ) = ( $3, "20$2" );
2047     } else {
2048       return "Illegal expiration date: ". $self->paydate;
2049     }
2050     $self->paydate("$y-$m-01");
2051     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2052     return gettext('expired_card')
2053       if !$import
2054       && !$ignore_expired_card
2055       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2056   }
2057
2058   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2059        ( ! $conf->exists('require_cardname')
2060          || $self->payby !~ /^(CARD|DCRD)$/  )
2061   ) {
2062     $self->payname( $self->first. " ". $self->getfield('last') );
2063   } else {
2064     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
2065       or return gettext('illegal_name'). " payname: ". $self->payname;
2066     $self->payname($1);
2067   }
2068
2069   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2070     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2071     $self->$flag($1);
2072   }
2073
2074   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2075
2076   warn "$me check AFTER: \n". $self->_dump
2077     if $DEBUG > 2;
2078
2079   $self->SUPER::check;
2080 }
2081
2082 =item addr_fields
2083
2084 Returns a list of fields which have ship_ duplicates.
2085
2086 =cut
2087
2088 sub addr_fields {
2089   qw( last first company
2090       address1 address2 city county state zip country
2091       daytime night fax
2092     );
2093 }
2094
2095 =item has_ship_address
2096
2097 Returns true if this customer record has a separate shipping address.
2098
2099 =cut
2100
2101 sub has_ship_address {
2102   my $self = shift;
2103   scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
2104 }
2105
2106 =item location_hash
2107
2108 Returns a list of key/value pairs, with the following keys: address1, adddress2,
2109 city, county, state, zip, country.  The shipping address is used if present.
2110
2111 =cut
2112
2113 #geocode?  dependent on tax-ship_address config, not available in cust_location
2114 #mostly.  not yet then.
2115
2116 sub location_hash {
2117   my $self = shift;
2118   my $prefix = $self->has_ship_address ? 'ship_' : '';
2119
2120   map { $_ => $self->get($prefix.$_) }
2121       qw( address1 address2 city county state zip country geocode );
2122       #fields that cust_location has
2123 }
2124
2125 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2126
2127 Returns all packages (see L<FS::cust_pkg>) for this customer.
2128
2129 =cut
2130
2131 sub all_pkgs {
2132   my $self = shift;
2133   my $extra_qsearch = ref($_[0]) ? shift : {};
2134
2135   return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
2136
2137   my @cust_pkg = ();
2138   if ( $self->{'_pkgnum'} ) {
2139     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
2140   } else {
2141     @cust_pkg = $self->_cust_pkg($extra_qsearch);
2142   }
2143
2144   sort sort_packages @cust_pkg;
2145 }
2146
2147 =item cust_pkg
2148
2149 Synonym for B<all_pkgs>.
2150
2151 =cut
2152
2153 sub cust_pkg {
2154   shift->all_pkgs(@_);
2155 }
2156
2157 =item cust_location
2158
2159 Returns all locations (see L<FS::cust_location>) for this customer.
2160
2161 =cut
2162
2163 sub cust_location {
2164   my $self = shift;
2165   qsearch('cust_location', { 'custnum' => $self->custnum } );
2166 }
2167
2168 =item location_label [ OPTION => VALUE ... ]
2169
2170 Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
2171
2172 Options are
2173
2174 =over 4
2175
2176 =item join_string
2177
2178 used to separate the address elements (defaults to ', ')
2179
2180 =item escape_function
2181
2182 a callback used for escaping the text of the address elements
2183
2184 =back
2185
2186 =cut
2187
2188 # false laziness with FS::cust_location::line
2189
2190 sub location_label {
2191   my $self = shift;
2192   my %opt = @_;
2193
2194   my $separator = $opt{join_string} || ', ';
2195   my $escape = $opt{escape_function} || sub{ shift };
2196   my $line = '';
2197   my $cydefault = FS::conf->new->config('countrydefault') || 'US';
2198   my $prefix = length($self->ship_last) ? 'ship_' : '';
2199
2200   my $notfirst = 0;
2201   foreach (qw ( address1 address2 ) ) {
2202     my $method = "$prefix$_";
2203     $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
2204       if $self->$method;
2205     $notfirst++;
2206   }
2207   $notfirst = 0;
2208   foreach (qw ( city county state zip ) ) {
2209     my $method = "$prefix$_";
2210     if ( $self->$method ) {
2211       $line .= ' (' if $method eq 'county';
2212       $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
2213       $line .= ' )' if $method eq 'county';
2214       $notfirst++;
2215     }
2216   }
2217   $line .= $separator. &$escape(code2country($self->country))
2218     if $self->country ne $cydefault;
2219
2220   $line;
2221 }
2222
2223 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2224
2225 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
2226
2227 =cut
2228
2229 sub ncancelled_pkgs {
2230   my $self = shift;
2231   my $extra_qsearch = ref($_[0]) ? shift : {};
2232
2233   return $self->num_ncancelled_pkgs unless wantarray;
2234
2235   my @cust_pkg = ();
2236   if ( $self->{'_pkgnum'} ) {
2237
2238     warn "$me ncancelled_pkgs: returning cached objects"
2239       if $DEBUG > 1;
2240
2241     @cust_pkg = grep { ! $_->getfield('cancel') }
2242                 values %{ $self->{'_pkgnum'}->cache };
2243
2244   } else {
2245
2246     warn "$me ncancelled_pkgs: searching for packages with custnum ".
2247          $self->custnum. "\n"
2248       if $DEBUG > 1;
2249
2250     $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
2251
2252     @cust_pkg = $self->_cust_pkg($extra_qsearch);
2253
2254   }
2255
2256   sort sort_packages @cust_pkg;
2257
2258 }
2259
2260 sub _cust_pkg {
2261   my $self = shift;
2262   my $extra_qsearch = ref($_[0]) ? shift : {};
2263
2264   $extra_qsearch->{'select'} ||= '*';
2265   $extra_qsearch->{'select'} .=
2266    ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
2267      AS _num_cust_svc';
2268
2269   map {
2270         $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
2271         $_;
2272       }
2273   qsearch({
2274     %$extra_qsearch,
2275     'table'   => 'cust_pkg',
2276     'hashref' => { 'custnum' => $self->custnum },
2277   });
2278
2279 }
2280
2281 # This should be generalized to use config options to determine order.
2282 sub sort_packages {
2283
2284   my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
2285   return $locationsort if $locationsort;
2286
2287   if ( $a->get('cancel') xor $b->get('cancel') ) {
2288     return -1 if $b->get('cancel');
2289     return  1 if $a->get('cancel');
2290     #shouldn't get here...
2291     return 0;
2292   } else {
2293     my $a_num_cust_svc = $a->num_cust_svc;
2294     my $b_num_cust_svc = $b->num_cust_svc;
2295     return 0  if !$a_num_cust_svc && !$b_num_cust_svc;
2296     return -1 if  $a_num_cust_svc && !$b_num_cust_svc;
2297     return 1  if !$a_num_cust_svc &&  $b_num_cust_svc;
2298     my @a_cust_svc = $a->cust_svc;
2299     my @b_cust_svc = $b->cust_svc;
2300     return 0  if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2301     return -1 if  scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2302     return 1  if !scalar(@a_cust_svc) &&  scalar(@b_cust_svc);
2303     $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2304   }
2305
2306 }
2307
2308 =item suspended_pkgs
2309
2310 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2311
2312 =cut
2313
2314 sub suspended_pkgs {
2315   my $self = shift;
2316   grep { $_->susp } $self->ncancelled_pkgs;
2317 }
2318
2319 =item unflagged_suspended_pkgs
2320
2321 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2322 customer (thouse packages without the `manual_flag' set).
2323
2324 =cut
2325
2326 sub unflagged_suspended_pkgs {
2327   my $self = shift;
2328   return $self->suspended_pkgs
2329     unless dbdef->table('cust_pkg')->column('manual_flag');
2330   grep { ! $_->manual_flag } $self->suspended_pkgs;
2331 }
2332
2333 =item unsuspended_pkgs
2334
2335 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2336 this customer.
2337
2338 =cut
2339
2340 sub unsuspended_pkgs {
2341   my $self = shift;
2342   grep { ! $_->susp } $self->ncancelled_pkgs;
2343 }
2344
2345 =item next_bill_date
2346
2347 Returns the next date this customer will be billed, as a UNIX timestamp, or
2348 undef if no active package has a next bill date.
2349
2350 =cut
2351
2352 sub next_bill_date {
2353   my $self = shift;
2354   min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
2355 }
2356
2357 =item num_cancelled_pkgs
2358
2359 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2360 customer.
2361
2362 =cut
2363
2364 sub num_cancelled_pkgs {
2365   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2366 }
2367
2368 sub num_ncancelled_pkgs {
2369   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2370 }
2371
2372 sub num_pkgs {
2373   my( $self ) = shift;
2374   my $sql = scalar(@_) ? shift : '';
2375   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2376   my $sth = dbh->prepare(
2377     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2378   ) or die dbh->errstr;
2379   $sth->execute($self->custnum) or die $sth->errstr;
2380   $sth->fetchrow_arrayref->[0];
2381 }
2382
2383 =item unsuspend
2384
2385 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2386 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
2387 on success or a list of errors.
2388
2389 =cut
2390
2391 sub unsuspend {
2392   my $self = shift;
2393   grep { $_->unsuspend } $self->suspended_pkgs;
2394 }
2395
2396 =item suspend
2397
2398 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2399
2400 Returns a list: an empty list on success or a list of errors.
2401
2402 =cut
2403
2404 sub suspend {
2405   my $self = shift;
2406   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2407 }
2408
2409 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2410
2411 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2412 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2413 of a list of pkgparts; the hashref has the following keys:
2414
2415 =over 4
2416
2417 =item pkgparts - listref of pkgparts
2418
2419 =item (other options are passed to the suspend method)
2420
2421 =back
2422
2423
2424 Returns a list: an empty list on success or a list of errors.
2425
2426 =cut
2427
2428 sub suspend_if_pkgpart {
2429   my $self = shift;
2430   my (@pkgparts, %opt);
2431   if (ref($_[0]) eq 'HASH'){
2432     @pkgparts = @{$_[0]{pkgparts}};
2433     %opt      = %{$_[0]};
2434   }else{
2435     @pkgparts = @_;
2436   }
2437   grep { $_->suspend(%opt) }
2438     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2439       $self->unsuspended_pkgs;
2440 }
2441
2442 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2443
2444 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2445 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2446 instead of a list of pkgparts; the hashref has the following keys:
2447
2448 =over 4
2449
2450 =item pkgparts - listref of pkgparts
2451
2452 =item (other options are passed to the suspend method)
2453
2454 =back
2455
2456 Returns a list: an empty list on success or a list of errors.
2457
2458 =cut
2459
2460 sub suspend_unless_pkgpart {
2461   my $self = shift;
2462   my (@pkgparts, %opt);
2463   if (ref($_[0]) eq 'HASH'){
2464     @pkgparts = @{$_[0]{pkgparts}};
2465     %opt      = %{$_[0]};
2466   }else{
2467     @pkgparts = @_;
2468   }
2469   grep { $_->suspend(%opt) }
2470     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2471       $self->unsuspended_pkgs;
2472 }
2473
2474 =item cancel [ OPTION => VALUE ... ]
2475
2476 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2477
2478 Available options are:
2479
2480 =over 4
2481
2482 =item quiet - can be set true to supress email cancellation notices.
2483
2484 =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.
2485
2486 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2487
2488 =item nobill - can be set true to skip billing if it might otherwise be done.
2489
2490 =back
2491
2492 Always returns a list: an empty list on success or a list of errors.
2493
2494 =cut
2495
2496 # nb that dates are not specified as valid options to this method
2497
2498 sub cancel {
2499   my( $self, %opt ) = @_;
2500
2501   warn "$me cancel called on customer ". $self->custnum. " with options ".
2502        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2503     if $DEBUG;
2504
2505   return ( 'access denied' )
2506     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2507
2508   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2509
2510     #should try decryption (we might have the private key)
2511     # and if not maybe queue a job for the server that does?
2512     return ( "Can't (yet) ban encrypted credit cards" )
2513       if $self->is_encrypted($self->payinfo);
2514
2515     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2516     my $error = $ban->insert;
2517     return ( $error ) if $error;
2518
2519   }
2520
2521   my @pkgs = $self->ncancelled_pkgs;
2522
2523   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2524     $opt{nobill} = 1;
2525     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2526     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2527       if $error;
2528   }
2529
2530   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2531        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2532     if $DEBUG;
2533
2534   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2535 }
2536
2537 sub _banned_pay_hashref {
2538   my $self = shift;
2539
2540   my %payby2ban = (
2541     'CARD' => 'CARD',
2542     'DCRD' => 'CARD',
2543     'CHEK' => 'CHEK',
2544     'DCHK' => 'CHEK'
2545   );
2546
2547   {
2548     'payby'   => $payby2ban{$self->payby},
2549     'payinfo' => md5_base64($self->payinfo),
2550     #don't ever *search* on reason! #'reason'  =>
2551   };
2552 }
2553
2554 =item notes
2555
2556 Returns all notes (see L<FS::cust_main_note>) for this customer.
2557
2558 =cut
2559
2560 sub notes {
2561   my $self = shift;
2562   #order by?
2563   qsearch( 'cust_main_note',
2564            { 'custnum' => $self->custnum },
2565            '',
2566            'ORDER BY _DATE DESC'
2567          );
2568 }
2569
2570 =item agent
2571
2572 Returns the agent (see L<FS::agent>) for this customer.
2573
2574 =cut
2575
2576 sub agent {
2577   my $self = shift;
2578   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2579 }
2580
2581 =item agent_name
2582
2583 Returns the agent name (see L<FS::agent>) for this customer.
2584
2585 =cut
2586
2587 sub agent_name {
2588   my $self = shift;
2589   $self->agent->agent;
2590 }
2591
2592 =item cust_tag
2593
2594 Returns any tags associated with this customer, as FS::cust_tag objects,
2595 or an empty list if there are no tags.
2596
2597 =cut
2598
2599 sub cust_tag {
2600   my $self = shift;
2601   qsearch('cust_tag', { 'custnum' => $self->custnum } );
2602 }
2603
2604 =item part_tag
2605
2606 Returns any tags associated with this customer, as FS::part_tag objects,
2607 or an empty list if there are no tags.
2608
2609 =cut
2610
2611 sub part_tag {
2612   my $self = shift;
2613   map $_->part_tag, $self->cust_tag;
2614 }
2615
2616
2617 =item cust_class
2618
2619 Returns the customer class, as an FS::cust_class object, or the empty string
2620 if there is no customer class.
2621
2622 =cut
2623
2624 sub cust_class {
2625   my $self = shift;
2626   if ( $self->classnum ) {
2627     qsearchs('cust_class', { 'classnum' => $self->classnum } );
2628   } else {
2629     return '';
2630   }
2631 }
2632
2633 =item categoryname
2634
2635 Returns the customer category name, or the empty string if there is no customer
2636 category.
2637
2638 =cut
2639
2640 sub categoryname {
2641   my $self = shift;
2642   my $cust_class = $self->cust_class;
2643   $cust_class
2644     ? $cust_class->categoryname
2645     : '';
2646 }
2647
2648 =item classname
2649
2650 Returns the customer class name, or the empty string if there is no customer
2651 class.
2652
2653 =cut
2654
2655 sub classname {
2656   my $self = shift;
2657   my $cust_class = $self->cust_class;
2658   $cust_class
2659     ? $cust_class->classname
2660     : '';
2661 }
2662
2663 =item BILLING METHODS
2664
2665 Documentation on billing methods has been moved to
2666 L<FS::cust_main::Billing>.
2667
2668 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
2669
2670 Runs billing events; see L<FS::part_event> and the billing events web
2671 interface.
2672
2673 If there is an error, returns the error, otherwise returns false.
2674
2675 Options are passed as name-value pairs.
2676
2677 Currently available options are:
2678
2679 =over 4
2680
2681 =item time
2682
2683 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.
2684
2685 =item check_freq
2686
2687 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2688
2689 =item stage
2690
2691 "collect" (the default) or "pre-bill"
2692
2693 =item quiet
2694
2695 set true to surpress email card/ACH decline notices.
2696
2697 =item debug
2698
2699 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)
2700
2701 =cut
2702
2703 # =item payby
2704 #
2705 # allows for one time override of normal customer billing method
2706
2707 # =item retry
2708 #
2709 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
2710
2711 sub do_cust_event {
2712   my( $self, %options ) = @_;
2713   my $time = $options{'time'} || time;
2714
2715   #put below somehow?
2716   local $SIG{HUP} = 'IGNORE';
2717   local $SIG{INT} = 'IGNORE';
2718   local $SIG{QUIT} = 'IGNORE';
2719   local $SIG{TERM} = 'IGNORE';
2720   local $SIG{TSTP} = 'IGNORE';
2721   local $SIG{PIPE} = 'IGNORE';
2722
2723   my $oldAutoCommit = $FS::UID::AutoCommit;
2724   local $FS::UID::AutoCommit = 0;
2725   my $dbh = dbh;
2726
2727   $self->select_for_update; #mutex
2728
2729   if ( $DEBUG ) {
2730     my $balance = $self->balance;
2731     warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
2732   }
2733
2734 #  if ( exists($options{'retry_card'}) ) {
2735 #    carp 'retry_card option passed to collect is deprecated; use retry';
2736 #    $options{'retry'} ||= $options{'retry_card'};
2737 #  }
2738 #  if ( exists($options{'retry'}) && $options{'retry'} ) {
2739 #    my $error = $self->retry_realtime;
2740 #    if ( $error ) {
2741 #      $dbh->rollback if $oldAutoCommit;
2742 #      return $error;
2743 #    }
2744 #  }
2745
2746   # false laziness w/pay_batch::import_results
2747
2748   my $due_cust_event = $self->due_cust_event(
2749     'debug'      => ( $options{'debug'} || 0 ),
2750     'time'       => $time,
2751     'check_freq' => $options{'check_freq'},
2752     'stage'      => ( $options{'stage'} || 'collect' ),
2753   );
2754   unless( ref($due_cust_event) ) {
2755     $dbh->rollback if $oldAutoCommit;
2756     return $due_cust_event;
2757   }
2758
2759   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2760   #never want to roll back an event just because it or a different one
2761   # returned an error
2762   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
2763
2764   foreach my $cust_event ( @$due_cust_event ) {
2765
2766     #XXX lock event
2767
2768     #re-eval event conditions (a previous event could have changed things)
2769     unless ( $cust_event->test_conditions( 'time' => $time ) ) {
2770       #don't leave stray "new/locked" records around
2771       my $error = $cust_event->delete;
2772       return $error if $error;
2773       next;
2774     }
2775
2776     {
2777       local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
2778       warn "  running cust_event ". $cust_event->eventnum. "\n"
2779         if $DEBUG > 1;
2780
2781       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
2782       if ( my $error = $cust_event->do_event() ) {
2783         #XXX wtf is this?  figure out a proper dealio with return value
2784         #from do_event
2785         return $error;
2786       }
2787     }
2788
2789   }
2790
2791   '';
2792
2793 }
2794
2795 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
2796
2797 Inserts database records for and returns an ordered listref of new events due
2798 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
2799 events are due, an empty listref is returned.  If there is an error, returns a
2800 scalar error message.
2801
2802 To actually run the events, call each event's test_condition method, and if
2803 still true, call the event's do_event method.
2804
2805 Options are passed as a hashref or as a list of name-value pairs.  Available
2806 options are:
2807
2808 =over 4
2809
2810 =item check_freq
2811
2812 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.
2813
2814 =item stage
2815
2816 "collect" (the default) or "pre-bill"
2817
2818 =item time
2819
2820 "Current time" for the events.
2821
2822 =item debug
2823
2824 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)
2825
2826 =item eventtable
2827
2828 Only return events for the specified eventtable (by default, events of all eventtables are returned)
2829
2830 =item objects
2831
2832 Explicitly pass the objects to be tested (typically used with eventtable).
2833
2834 =item testonly
2835
2836 Set to true to return the objects, but not actually insert them into the
2837 database.
2838
2839 =back
2840
2841 =cut
2842
2843 sub due_cust_event {
2844   my $self = shift;
2845   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
2846
2847   #???
2848   #my $DEBUG = $opt{'debug'}
2849   local($DEBUG) = $opt{'debug'}
2850     if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
2851
2852   warn "$me due_cust_event called with options ".
2853        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
2854     if $DEBUG;
2855
2856   $opt{'time'} ||= time;
2857
2858   local $SIG{HUP} = 'IGNORE';
2859   local $SIG{INT} = 'IGNORE';
2860   local $SIG{QUIT} = 'IGNORE';
2861   local $SIG{TERM} = 'IGNORE';
2862   local $SIG{TSTP} = 'IGNORE';
2863   local $SIG{PIPE} = 'IGNORE';
2864
2865   my $oldAutoCommit = $FS::UID::AutoCommit;
2866   local $FS::UID::AutoCommit = 0;
2867   my $dbh = dbh;
2868
2869   $self->select_for_update #mutex
2870     unless $opt{testonly};
2871
2872   ###
2873   # find possible events (initial search)
2874   ###
2875
2876   my @cust_event = ();
2877
2878   my @eventtable = $opt{'eventtable'}
2879                      ? ( $opt{'eventtable'} )
2880                      : FS::part_event->eventtables_runorder;
2881
2882   foreach my $eventtable ( @eventtable ) {
2883
2884     my @objects;
2885     if ( $opt{'objects'} ) {
2886
2887       @objects = @{ $opt{'objects'} };
2888
2889     } else {
2890
2891       #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
2892       @objects = ( $eventtable eq 'cust_main' )
2893                    ? ( $self )
2894                    : ( $self->$eventtable() );
2895
2896     }
2897
2898     my @e_cust_event = ();
2899
2900     my $cross = "CROSS JOIN $eventtable";
2901     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
2902       unless $eventtable eq 'cust_main';
2903
2904     foreach my $object ( @objects ) {
2905
2906       #this first search uses the condition_sql magic for optimization.
2907       #the more possible events we can eliminate in this step the better
2908
2909       my $cross_where = '';
2910       my $pkey = $object->primary_key;
2911       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
2912
2913       my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
2914       my $extra_sql =
2915         FS::part_event_condition->where_conditions_sql( $eventtable,
2916                                                         'time'=>$opt{'time'}
2917                                                       );
2918       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
2919
2920       $extra_sql = "AND $extra_sql" if $extra_sql;
2921
2922       #here is the agent virtualization
2923       $extra_sql .= " AND (    part_event.agentnum IS NULL
2924                             OR part_event.agentnum = ". $self->agentnum. ' )';
2925
2926       $extra_sql .= " $order";
2927
2928       warn "searching for events for $eventtable ". $object->$pkey. "\n"
2929         if $opt{'debug'} > 2;
2930       my @part_event = qsearch( {
2931         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
2932         'select'    => 'part_event.*',
2933         'table'     => 'part_event',
2934         'addl_from' => "$cross $join",
2935         'hashref'   => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
2936                          'eventtable' => $eventtable,
2937                          'disabled'   => '',
2938                        },
2939         'extra_sql' => "AND $cross_where $extra_sql",
2940       } );
2941
2942       if ( $DEBUG > 2 ) {
2943         my $pkey = $object->primary_key;
2944         warn "      ". scalar(@part_event).
2945              " possible events found for $eventtable ". $object->$pkey(). "\n";
2946       }
2947
2948       push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
2949
2950     }
2951
2952     warn "    ". scalar(@e_cust_event).
2953          " subtotal possible cust events found for $eventtable\n"
2954       if $DEBUG > 1;
2955
2956     push @cust_event, @e_cust_event;
2957
2958   }
2959
2960   warn "  ". scalar(@cust_event).
2961        " total possible cust events found in initial search\n"
2962     if $DEBUG; # > 1;
2963
2964
2965   ##
2966   # test stage
2967   ##
2968
2969   $opt{stage} ||= 'collect';
2970   @cust_event =
2971     grep { my $stage = $_->part_event->event_stage;
2972            $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
2973          }
2974          @cust_event;
2975
2976   ##
2977   # test conditions
2978   ##
2979
2980   my %unsat = ();
2981
2982   @cust_event = grep $_->test_conditions( 'time'          => $opt{'time'},
2983                                           'stats_hashref' => \%unsat ),
2984                      @cust_event;
2985
2986   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
2987     if $DEBUG; # > 1;
2988
2989   warn "    invalid conditions not eliminated with condition_sql:\n".
2990        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
2991     if keys %unsat && $DEBUG; # > 1;
2992
2993   ##
2994   # insert
2995   ##
2996
2997   unless( $opt{testonly} ) {
2998     foreach my $cust_event ( @cust_event ) {
2999
3000       my $error = $cust_event->insert();
3001       if ( $error ) {
3002         $dbh->rollback if $oldAutoCommit;
3003         return $error;
3004       }
3005
3006     }
3007   }
3008
3009   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3010
3011   ##
3012   # return
3013   ##
3014
3015   warn "  returning events: ". Dumper(@cust_event). "\n"
3016     if $DEBUG > 2;
3017
3018   \@cust_event;
3019
3020 }
3021
3022 =item retry_realtime
3023
3024 Schedules realtime / batch  credit card / electronic check / LEC billing
3025 events for for retry.  Useful if card information has changed or manual
3026 retry is desired.  The 'collect' method must be called to actually retry
3027 the transaction.
3028
3029 Implementation details: For either this customer, or for each of this
3030 customer's open invoices, changes the status of the first "done" (with
3031 statustext error) realtime processing event to "failed".
3032
3033 =cut
3034
3035 sub retry_realtime {
3036   my $self = shift;
3037
3038   local $SIG{HUP} = 'IGNORE';
3039   local $SIG{INT} = 'IGNORE';
3040   local $SIG{QUIT} = 'IGNORE';
3041   local $SIG{TERM} = 'IGNORE';
3042   local $SIG{TSTP} = 'IGNORE';
3043   local $SIG{PIPE} = 'IGNORE';
3044
3045   my $oldAutoCommit = $FS::UID::AutoCommit;
3046   local $FS::UID::AutoCommit = 0;
3047   my $dbh = dbh;
3048
3049   #a little false laziness w/due_cust_event (not too bad, really)
3050
3051   my $join = FS::part_event_condition->join_conditions_sql;
3052   my $order = FS::part_event_condition->order_conditions_sql;
3053   my $mine =
3054   '( '
3055    . join ( ' OR ' , map {
3056     "( part_event.eventtable = " . dbh->quote($_)
3057     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
3058    } FS::part_event->eventtables)
3059    . ') ';
3060
3061   #here is the agent virtualization
3062   my $agent_virt = " (    part_event.agentnum IS NULL
3063                        OR part_event.agentnum = ". $self->agentnum. ' )';
3064
3065   #XXX this shouldn't be hardcoded, actions should declare it...
3066   my @realtime_events = qw(
3067     cust_bill_realtime_card
3068     cust_bill_realtime_check
3069     cust_bill_realtime_lec
3070     cust_bill_batch
3071   );
3072
3073   my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
3074                                                   @realtime_events
3075                                      ).
3076                           ' ) ';
3077
3078   my @cust_event = qsearchs({
3079     'table'     => 'cust_event',
3080     'select'    => 'cust_event.*',
3081     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
3082     'hashref'   => { 'status' => 'done' },
3083     'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
3084                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
3085   });
3086
3087   my %seen_invnum = ();
3088   foreach my $cust_event (@cust_event) {
3089
3090     #max one for the customer, one for each open invoice
3091     my $cust_X = $cust_event->cust_X;
3092     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
3093                           ? $cust_X->invnum
3094                           : 0
3095                         }++
3096          or $cust_event->part_event->eventtable eq 'cust_bill'
3097             && ! $cust_X->owed;
3098
3099     my $error = $cust_event->retry;
3100     if ( $error ) {
3101       $dbh->rollback if $oldAutoCommit;
3102       return "error scheduling event for retry: $error";
3103     }
3104
3105   }
3106
3107   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3108   '';
3109
3110 }
3111
3112
3113 =cut
3114
3115 =item REALTIME BILLING METHODS
3116
3117 Documentation on realtime billing methods has been moved to
3118 L<FS::cust_main::Billing_Realtime>.
3119
3120 =item remove_cvv
3121
3122 Removes the I<paycvv> field from the database directly.
3123
3124 If there is an error, returns the error, otherwise returns false.
3125
3126 =cut
3127
3128 sub remove_cvv {
3129   my $self = shift;
3130   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
3131     or return dbh->errstr;
3132   $sth->execute($self->custnum)
3133     or return $sth->errstr;
3134   $self->paycvv('');
3135   '';
3136 }
3137
3138 =item batch_card OPTION => VALUE...
3139
3140 Adds a payment for this invoice to the pending credit card batch (see
3141 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
3142 runs the payment using a realtime gateway.
3143
3144 =cut
3145
3146 sub batch_card {
3147   my ($self, %options) = @_;
3148
3149   my $amount;
3150   if (exists($options{amount})) {
3151     $amount = $options{amount};
3152   }else{
3153     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
3154   }
3155   return '' unless $amount > 0;
3156
3157   my $invnum = delete $options{invnum};
3158   my $payby = $options{invnum} || $self->payby;  #dubious
3159
3160   if ($options{'realtime'}) {
3161     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
3162                                 $amount,
3163                                 %options,
3164                               );
3165   }
3166
3167   my $oldAutoCommit = $FS::UID::AutoCommit;
3168   local $FS::UID::AutoCommit = 0;
3169   my $dbh = dbh;
3170
3171   #this needs to handle mysql as well as Pg, like svc_acct.pm
3172   #(make it into a common function if folks need to do batching with mysql)
3173   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
3174     or return "Cannot lock pay_batch: " . $dbh->errstr;
3175
3176   my %pay_batch = (
3177     'status' => 'O',
3178     'payby'  => FS::payby->payby2payment($payby),
3179   );
3180
3181   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
3182
3183   unless ( $pay_batch ) {
3184     $pay_batch = new FS::pay_batch \%pay_batch;
3185     my $error = $pay_batch->insert;
3186     if ( $error ) {
3187       $dbh->rollback if $oldAutoCommit;
3188       die "error creating new batch: $error\n";
3189     }
3190   }
3191
3192   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
3193       'batchnum' => $pay_batch->batchnum,
3194       'custnum'  => $self->custnum,
3195   } );
3196
3197   foreach (qw( address1 address2 city state zip country payby payinfo paydate
3198                payname )) {
3199     $options{$_} = '' unless exists($options{$_});
3200   }
3201
3202   my $cust_pay_batch = new FS::cust_pay_batch ( {
3203     'batchnum' => $pay_batch->batchnum,
3204     'invnum'   => $invnum || 0,                    # is there a better value?
3205                                                    # this field should be
3206                                                    # removed...
3207                                                    # cust_bill_pay_batch now
3208     'custnum'  => $self->custnum,
3209     'last'     => $self->getfield('last'),
3210     'first'    => $self->getfield('first'),
3211     'address1' => $options{address1} || $self->address1,
3212     'address2' => $options{address2} || $self->address2,
3213     'city'     => $options{city}     || $self->city,
3214     'state'    => $options{state}    || $self->state,
3215     'zip'      => $options{zip}      || $self->zip,
3216     'country'  => $options{country}  || $self->country,
3217     'payby'    => $options{payby}    || $self->payby,
3218     'payinfo'  => $options{payinfo}  || $self->payinfo,
3219     'exp'      => $options{paydate}  || $self->paydate,
3220     'payname'  => $options{payname}  || $self->payname,
3221     'amount'   => $amount,                         # consolidating
3222   } );
3223
3224   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
3225     if $old_cust_pay_batch;
3226
3227   my $error;
3228   if ($old_cust_pay_batch) {
3229     $error = $cust_pay_batch->replace($old_cust_pay_batch)
3230   } else {
3231     $error = $cust_pay_batch->insert;
3232   }
3233
3234   if ( $error ) {
3235     $dbh->rollback if $oldAutoCommit;
3236     die $error;
3237   }
3238
3239   my $unapplied =   $self->total_unapplied_credits
3240                   + $self->total_unapplied_payments
3241                   + $self->in_transit_payments;
3242   foreach my $cust_bill ($self->open_cust_bill) {
3243     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
3244     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
3245       'invnum' => $cust_bill->invnum,
3246       'paybatchnum' => $cust_pay_batch->paybatchnum,
3247       'amount' => $cust_bill->owed,
3248       '_date' => time,
3249     };
3250     if ($unapplied >= $cust_bill_pay_batch->amount){
3251       $unapplied -= $cust_bill_pay_batch->amount;
3252       next;
3253     }else{
3254       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
3255                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
3256     }
3257     $error = $cust_bill_pay_batch->insert;
3258     if ( $error ) {
3259       $dbh->rollback if $oldAutoCommit;
3260       die $error;
3261     }
3262   }
3263
3264   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3265   '';
3266 }
3267
3268 =item total_owed
3269
3270 Returns the total owed for this customer on all invoices
3271 (see L<FS::cust_bill/owed>).
3272
3273 =cut
3274
3275 sub total_owed {
3276   my $self = shift;
3277   $self->total_owed_date(2145859200); #12/31/2037
3278 }
3279
3280 =item total_owed_date TIME
3281
3282 Returns the total owed for this customer on all invoices with date earlier than
3283 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
3284 see L<Time::Local> and L<Date::Parse> for conversion functions.
3285
3286 =cut
3287
3288 sub total_owed_date {
3289   my $self = shift;
3290   my $time = shift;
3291
3292   my $custnum = $self->custnum;
3293
3294   my $owed_sql = FS::cust_bill->owed_sql;
3295
3296   my $sql = "
3297     SELECT SUM($owed_sql) FROM cust_bill
3298       WHERE custnum = $custnum
3299         AND _date <= $time
3300   ";
3301
3302   sprintf( "%.2f", $self->scalar_sql($sql) );
3303
3304 }
3305
3306 =item total_owed_pkgnum PKGNUM
3307
3308 Returns the total owed on all invoices for this customer's specific package
3309 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
3310
3311 =cut
3312
3313 sub total_owed_pkgnum {
3314   my( $self, $pkgnum ) = @_;
3315   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
3316 }
3317
3318 =item total_owed_date_pkgnum TIME PKGNUM
3319
3320 Returns the total owed for this customer's specific package when using
3321 experimental package balances on all invoices with date earlier than
3322 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
3323 see L<Time::Local> and L<Date::Parse> for conversion functions.
3324
3325 =cut
3326
3327 sub total_owed_date_pkgnum {
3328   my( $self, $time, $pkgnum ) = @_;
3329
3330   my $total_bill = 0;
3331   foreach my $cust_bill (
3332     grep { $_->_date <= $time }
3333       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
3334   ) {
3335     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
3336   }
3337   sprintf( "%.2f", $total_bill );
3338
3339 }
3340
3341 =item total_paid
3342
3343 Returns the total amount of all payments.
3344
3345 =cut
3346
3347 sub total_paid {
3348   my $self = shift;
3349   my $total = 0;
3350   $total += $_->paid foreach $self->cust_pay;
3351   sprintf( "%.2f", $total );
3352 }
3353
3354 =item total_unapplied_credits
3355
3356 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3357 customer.  See L<FS::cust_credit/credited>.
3358
3359 =item total_credited
3360
3361 Old name for total_unapplied_credits.  Don't use.
3362
3363 =cut
3364
3365 sub total_credited {
3366   #carp "total_credited deprecated, use total_unapplied_credits";
3367   shift->total_unapplied_credits(@_);
3368 }
3369
3370 sub total_unapplied_credits {
3371   my $self = shift;
3372
3373   my $custnum = $self->custnum;
3374
3375   my $unapplied_sql = FS::cust_credit->unapplied_sql;
3376
3377   my $sql = "
3378     SELECT SUM($unapplied_sql) FROM cust_credit
3379       WHERE custnum = $custnum
3380   ";
3381
3382   sprintf( "%.2f", $self->scalar_sql($sql) );
3383
3384 }
3385
3386 =item total_unapplied_credits_pkgnum PKGNUM
3387
3388 Returns the total outstanding credit (see L<FS::cust_credit>) for this
3389 customer.  See L<FS::cust_credit/credited>.
3390
3391 =cut
3392
3393 sub total_unapplied_credits_pkgnum {
3394   my( $self, $pkgnum ) = @_;
3395   my $total_credit = 0;
3396   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
3397   sprintf( "%.2f", $total_credit );
3398 }
3399
3400
3401 =item total_unapplied_payments
3402
3403 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
3404 See L<FS::cust_pay/unapplied>.
3405
3406 =cut
3407
3408 sub total_unapplied_payments {
3409   my $self = shift;
3410
3411   my $custnum = $self->custnum;
3412
3413   my $unapplied_sql = FS::cust_pay->unapplied_sql;
3414
3415   my $sql = "
3416     SELECT SUM($unapplied_sql) FROM cust_pay
3417       WHERE custnum = $custnum
3418   ";
3419
3420   sprintf( "%.2f", $self->scalar_sql($sql) );
3421
3422 }
3423
3424 =item total_unapplied_payments_pkgnum PKGNUM
3425
3426 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
3427 specific package when using experimental package balances.  See
3428 L<FS::cust_pay/unapplied>.
3429
3430 =cut
3431
3432 sub total_unapplied_payments_pkgnum {
3433   my( $self, $pkgnum ) = @_;
3434   my $total_unapplied = 0;
3435   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
3436   sprintf( "%.2f", $total_unapplied );
3437 }
3438
3439
3440 =item total_unapplied_refunds
3441
3442 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
3443 customer.  See L<FS::cust_refund/unapplied>.
3444
3445 =cut
3446
3447 sub total_unapplied_refunds {
3448   my $self = shift;
3449   my $custnum = $self->custnum;
3450
3451   my $unapplied_sql = FS::cust_refund->unapplied_sql;
3452
3453   my $sql = "
3454     SELECT SUM($unapplied_sql) FROM cust_refund
3455       WHERE custnum = $custnum
3456   ";
3457
3458   sprintf( "%.2f", $self->scalar_sql($sql) );
3459
3460 }
3461
3462 =item balance
3463
3464 Returns the balance for this customer (total_owed plus total_unrefunded, minus
3465 total_unapplied_credits minus total_unapplied_payments).
3466
3467 =cut
3468
3469 sub balance {
3470   my $self = shift;
3471   $self->balance_date_range;
3472 }
3473
3474 =item balance_date TIME
3475
3476 Returns the balance for this customer, only considering invoices with date
3477 earlier than TIME (total_owed_date minus total_credited minus
3478 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
3479 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
3480 functions.
3481
3482 =cut
3483
3484 sub balance_date {
3485   my $self = shift;
3486   $self->balance_date_range(shift);
3487 }
3488
3489 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
3490
3491 Returns the balance for this customer, optionally considering invoices with
3492 date earlier than START_TIME, and not later than END_TIME
3493 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
3494
3495 Times are specified as SQL fragments or numeric
3496 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
3497 L<Date::Parse> for conversion functions.  The empty string can be passed
3498 to disable that time constraint completely.
3499
3500 Available options are:
3501
3502 =over 4
3503
3504 =item unapplied_date
3505
3506 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)
3507
3508 =back
3509
3510 =cut
3511
3512 sub balance_date_range {
3513   my $self = shift;
3514   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
3515             ') FROM cust_main WHERE custnum='. $self->custnum;
3516   sprintf( '%.2f', $self->scalar_sql($sql) );
3517 }
3518
3519 =item balance_pkgnum PKGNUM
3520
3521 Returns the balance for this customer's specific package when using
3522 experimental package balances (total_owed plus total_unrefunded, minus
3523 total_unapplied_credits minus total_unapplied_payments)
3524
3525 =cut
3526
3527 sub balance_pkgnum {
3528   my( $self, $pkgnum ) = @_;
3529
3530   sprintf( "%.2f",
3531       $self->total_owed_pkgnum($pkgnum)
3532 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
3533 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
3534     - $self->total_unapplied_credits_pkgnum($pkgnum)
3535     - $self->total_unapplied_payments_pkgnum($pkgnum)
3536   );
3537 }
3538
3539 =item in_transit_payments
3540
3541 Returns the total of requests for payments for this customer pending in
3542 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
3543
3544 =cut
3545
3546 sub in_transit_payments {
3547   my $self = shift;
3548   my $in_transit_payments = 0;
3549   foreach my $pay_batch ( qsearch('pay_batch', {
3550     'status' => 'I',
3551   } ) ) {
3552     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3553       'batchnum' => $pay_batch->batchnum,
3554       'custnum' => $self->custnum,
3555     } ) ) {
3556       $in_transit_payments += $cust_pay_batch->amount;
3557     }
3558   }
3559   sprintf( "%.2f", $in_transit_payments );
3560 }
3561
3562 =item payment_info
3563
3564 Returns a hash of useful information for making a payment.
3565
3566 =over 4
3567
3568 =item balance
3569
3570 Current balance.
3571
3572 =item payby
3573
3574 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
3575 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
3576 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
3577
3578 =back
3579
3580 For credit card transactions:
3581
3582 =over 4
3583
3584 =item card_type 1
3585
3586 =item payname
3587
3588 Exact name on card
3589
3590 =back
3591
3592 For electronic check transactions:
3593
3594 =over 4
3595
3596 =item stateid_state
3597
3598 =back
3599
3600 =cut
3601
3602 sub payment_info {
3603   my $self = shift;
3604
3605   my %return = ();
3606
3607   $return{balance} = $self->balance;
3608
3609   $return{payname} = $self->payname
3610                      || ( $self->first. ' '. $self->get('last') );
3611
3612   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
3613
3614   $return{payby} = $self->payby;
3615   $return{stateid_state} = $self->stateid_state;
3616
3617   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3618     $return{card_type} = cardtype($self->payinfo);
3619     $return{payinfo} = $self->paymask;
3620
3621     @return{'month', 'year'} = $self->paydate_monthyear;
3622
3623   }
3624
3625   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3626     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3627     $return{payinfo1} = $payinfo1;
3628     $return{payinfo2} = $payinfo2;
3629     $return{paytype}  = $self->paytype;
3630     $return{paystate} = $self->paystate;
3631
3632   }
3633
3634   #doubleclick protection
3635   my $_date = time;
3636   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3637
3638   %return;
3639
3640 }
3641
3642 =item paydate_monthyear
3643
3644 Returns a two-element list consisting of the month and year of this customer's
3645 paydate (credit card expiration date for CARD customers)
3646
3647 =cut
3648
3649 sub paydate_monthyear {
3650   my $self = shift;
3651   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3652     ( $2, $1 );
3653   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3654     ( $1, $3 );
3655   } else {
3656     ('', '');
3657   }
3658 }
3659
3660 =item tax_exemption TAXNAME
3661
3662 =cut
3663
3664 sub tax_exemption {
3665   my( $self, $taxname ) = @_;
3666
3667   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3668                                      'taxname' => $taxname,
3669                                    },
3670           );
3671 }
3672
3673 =item cust_main_exemption
3674
3675 =cut
3676
3677 sub cust_main_exemption {
3678   my $self = shift;
3679   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3680 }
3681
3682 =item invoicing_list [ ARRAYREF ]
3683
3684 If an arguement is given, sets these email addresses as invoice recipients
3685 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3686 (except as warnings), so use check_invoicing_list first.
3687
3688 Returns a list of email addresses (with svcnum entries expanded).
3689
3690 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3691 check it without disturbing anything by passing nothing.
3692
3693 This interface may change in the future.
3694
3695 =cut
3696
3697 sub invoicing_list {
3698   my( $self, $arrayref ) = @_;
3699
3700   if ( $arrayref ) {
3701     my @cust_main_invoice;
3702     if ( $self->custnum ) {
3703       @cust_main_invoice =
3704         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3705     } else {
3706       @cust_main_invoice = ();
3707     }
3708     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3709       #warn $cust_main_invoice->destnum;
3710       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3711         #warn $cust_main_invoice->destnum;
3712         my $error = $cust_main_invoice->delete;
3713         warn $error if $error;
3714       }
3715     }
3716     if ( $self->custnum ) {
3717       @cust_main_invoice =
3718         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3719     } else {
3720       @cust_main_invoice = ();
3721     }
3722     my %seen = map { $_->address => 1 } @cust_main_invoice;
3723     foreach my $address ( @{$arrayref} ) {
3724       next if exists $seen{$address} && $seen{$address};
3725       $seen{$address} = 1;
3726       my $cust_main_invoice = new FS::cust_main_invoice ( {
3727         'custnum' => $self->custnum,
3728         'dest'    => $address,
3729       } );
3730       my $error = $cust_main_invoice->insert;
3731       warn $error if $error;
3732     }
3733   }
3734
3735   if ( $self->custnum ) {
3736     map { $_->address }
3737       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3738   } else {
3739     ();
3740   }
3741
3742 }
3743
3744 =item check_invoicing_list ARRAYREF
3745
3746 Checks these arguements as valid input for the invoicing_list method.  If there
3747 is an error, returns the error, otherwise returns false.
3748
3749 =cut
3750
3751 sub check_invoicing_list {
3752   my( $self, $arrayref ) = @_;
3753
3754   foreach my $address ( @$arrayref ) {
3755
3756     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3757       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3758     }
3759
3760     my $cust_main_invoice = new FS::cust_main_invoice ( {
3761       'custnum' => $self->custnum,
3762       'dest'    => $address,
3763     } );
3764     my $error = $self->custnum
3765                 ? $cust_main_invoice->check
3766                 : $cust_main_invoice->checkdest
3767     ;
3768     return $error if $error;
3769
3770   }
3771
3772   return "Email address required"
3773     if $conf->exists('cust_main-require_invoicing_list_email')
3774     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3775
3776   '';
3777 }
3778
3779 =item set_default_invoicing_list
3780
3781 Sets the invoicing list to all accounts associated with this customer,
3782 overwriting any previous invoicing list.
3783
3784 =cut
3785
3786 sub set_default_invoicing_list {
3787   my $self = shift;
3788   $self->invoicing_list($self->all_emails);
3789 }
3790
3791 =item all_emails
3792
3793 Returns the email addresses of all accounts provisioned for this customer.
3794
3795 =cut
3796
3797 sub all_emails {
3798   my $self = shift;
3799   my %list;
3800   foreach my $cust_pkg ( $self->all_pkgs ) {
3801     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3802     my @svc_acct =
3803       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3804         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3805           @cust_svc;
3806     $list{$_}=1 foreach map { $_->email } @svc_acct;
3807   }
3808   keys %list;
3809 }
3810
3811 =item invoicing_list_addpost
3812
3813 Adds postal invoicing to this customer.  If this customer is already configured
3814 to receive postal invoices, does nothing.
3815
3816 =cut
3817
3818 sub invoicing_list_addpost {
3819   my $self = shift;
3820   return if grep { $_ eq 'POST' } $self->invoicing_list;
3821   my @invoicing_list = $self->invoicing_list;
3822   push @invoicing_list, 'POST';
3823   $self->invoicing_list(\@invoicing_list);
3824 }
3825
3826 =item invoicing_list_emailonly
3827
3828 Returns the list of email invoice recipients (invoicing_list without non-email
3829 destinations such as POST and FAX).
3830
3831 =cut
3832
3833 sub invoicing_list_emailonly {
3834   my $self = shift;
3835   warn "$me invoicing_list_emailonly called"
3836     if $DEBUG;
3837   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3838 }
3839
3840 =item invoicing_list_emailonly_scalar
3841
3842 Returns the list of email invoice recipients (invoicing_list without non-email
3843 destinations such as POST and FAX) as a comma-separated scalar.
3844
3845 =cut
3846
3847 sub invoicing_list_emailonly_scalar {
3848   my $self = shift;
3849   warn "$me invoicing_list_emailonly_scalar called"
3850     if $DEBUG;
3851   join(', ', $self->invoicing_list_emailonly);
3852 }
3853
3854 =item referral_custnum_cust_main
3855
3856 Returns the customer who referred this customer (or the empty string, if
3857 this customer was not referred).
3858
3859 Note the difference with referral_cust_main method: This method,
3860 referral_custnum_cust_main returns the single customer (if any) who referred
3861 this customer, while referral_cust_main returns an array of customers referred
3862 BY this customer.
3863
3864 =cut
3865
3866 sub referral_custnum_cust_main {
3867   my $self = shift;
3868   return '' unless $self->referral_custnum;
3869   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3870 }
3871
3872 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3873
3874 Returns an array of customers referred by this customer (referral_custnum set
3875 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3876 customers referred by customers referred by this customer and so on, inclusive.
3877 The default behavior is DEPTH 1 (no recursion).
3878
3879 Note the difference with referral_custnum_cust_main method: This method,
3880 referral_cust_main, returns an array of customers referred BY this customer,
3881 while referral_custnum_cust_main returns the single customer (if any) who
3882 referred this customer.
3883
3884 =cut
3885
3886 sub referral_cust_main {
3887   my $self = shift;
3888   my $depth = @_ ? shift : 1;
3889   my $exclude = @_ ? shift : {};
3890
3891   my @cust_main =
3892     map { $exclude->{$_->custnum}++; $_; }
3893       grep { ! $exclude->{ $_->custnum } }
3894         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3895
3896   if ( $depth > 1 ) {
3897     push @cust_main,
3898       map { $_->referral_cust_main($depth-1, $exclude) }
3899         @cust_main;
3900   }
3901
3902   @cust_main;
3903 }
3904
3905 =item referral_cust_main_ncancelled
3906
3907 Same as referral_cust_main, except only returns customers with uncancelled
3908 packages.
3909
3910 =cut
3911
3912 sub referral_cust_main_ncancelled {
3913   my $self = shift;
3914   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3915 }
3916
3917 =item referral_cust_pkg [ DEPTH ]
3918
3919 Like referral_cust_main, except returns a flat list of all unsuspended (and
3920 uncancelled) packages for each customer.  The number of items in this list may
3921 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3922
3923 =cut
3924
3925 sub referral_cust_pkg {
3926   my $self = shift;
3927   my $depth = @_ ? shift : 1;
3928
3929   map { $_->unsuspended_pkgs }
3930     grep { $_->unsuspended_pkgs }
3931       $self->referral_cust_main($depth);
3932 }
3933
3934 =item referring_cust_main
3935
3936 Returns the single cust_main record for the customer who referred this customer
3937 (referral_custnum), or false.
3938
3939 =cut
3940
3941 sub referring_cust_main {
3942   my $self = shift;
3943   return '' unless $self->referral_custnum;
3944   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3945 }
3946
3947 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3948
3949 Applies a credit to this customer.  If there is an error, returns the error,
3950 otherwise returns false.
3951
3952 REASON can be a text string, an FS::reason object, or a scalar reference to
3953 a reasonnum.  If a text string, it will be automatically inserted as a new
3954 reason, and a 'reason_type' option must be passed to indicate the
3955 FS::reason_type for the new reason.
3956
3957 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3958
3959 Any other options are passed to FS::cust_credit::insert.
3960
3961 =cut
3962
3963 sub credit {
3964   my( $self, $amount, $reason, %options ) = @_;
3965
3966   my $cust_credit = new FS::cust_credit {
3967     'custnum' => $self->custnum,
3968     'amount'  => $amount,
3969   };
3970
3971   if ( ref($reason) ) {
3972
3973     if ( ref($reason) eq 'SCALAR' ) {
3974       $cust_credit->reasonnum( $$reason );
3975     } else {
3976       $cust_credit->reasonnum( $reason->reasonnum );
3977     }
3978
3979   } else {
3980     $cust_credit->set('reason', $reason)
3981   }
3982
3983   for (qw( addlinfo eventnum )) {
3984     $cust_credit->$_( delete $options{$_} )
3985       if exists($options{$_});
3986   }
3987
3988   $cust_credit->insert(%options);
3989
3990 }
3991
3992 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3993
3994 Creates a one-time charge for this customer.  If there is an error, returns
3995 the error, otherwise returns false.
3996
3997 New-style, with a hashref of options:
3998
3999   my $error = $cust_main->charge(
4000                                   {
4001                                     'amount'     => 54.32,
4002                                     'quantity'   => 1,
4003                                     'start_date' => str2time('7/4/2009'),
4004                                     'pkg'        => 'Description',
4005                                     'comment'    => 'Comment',
4006                                     'additional' => [], #extra invoice detail
4007                                     'classnum'   => 1,  #pkg_class
4008
4009                                     'setuptax'   => '', # or 'Y' for tax exempt
4010
4011                                     #internal taxation
4012                                     'taxclass'   => 'Tax class',
4013
4014                                     #vendor taxation
4015                                     'taxproduct' => 2,  #part_pkg_taxproduct
4016                                     'override'   => {}, #XXX describe
4017
4018                                     #will be filled in with the new object
4019                                     'cust_pkg_ref' => \$cust_pkg,
4020
4021                                     #generate an invoice immediately
4022                                     'bill_now' => 0,
4023                                     'invoice_terms' => '', #with these terms
4024                                   }
4025                                 );
4026
4027 Old-style:
4028
4029   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
4030
4031 =cut
4032
4033 sub charge {
4034   my $self = shift;
4035   my ( $amount, $quantity, $start_date, $classnum );
4036   my ( $pkg, $comment, $additional );
4037   my ( $setuptax, $taxclass );   #internal taxes
4038   my ( $taxproduct, $override ); #vendor (CCH) taxes
4039   my $no_auto = '';
4040   my $cust_pkg_ref = '';
4041   my ( $bill_now, $invoice_terms ) = ( 0, '' );
4042   if ( ref( $_[0] ) ) {
4043     $amount     = $_[0]->{amount};
4044     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
4045     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
4046     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
4047     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
4048     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
4049                                            : '$'. sprintf("%.2f",$amount);
4050     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
4051     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
4052     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
4053     $additional = $_[0]->{additional} || [];
4054     $taxproduct = $_[0]->{taxproductnum};
4055     $override   = { '' => $_[0]->{tax_override} };
4056     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
4057     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
4058     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
4059   } else {
4060     $amount     = shift;
4061     $quantity   = 1;
4062     $start_date = '';
4063     $pkg        = @_ ? shift : 'One-time charge';
4064     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
4065     $setuptax   = '';
4066     $taxclass   = @_ ? shift : '';
4067     $additional = [];
4068   }
4069
4070   local $SIG{HUP} = 'IGNORE';
4071   local $SIG{INT} = 'IGNORE';
4072   local $SIG{QUIT} = 'IGNORE';
4073   local $SIG{TERM} = 'IGNORE';
4074   local $SIG{TSTP} = 'IGNORE';
4075   local $SIG{PIPE} = 'IGNORE';
4076
4077   my $oldAutoCommit = $FS::UID::AutoCommit;
4078   local $FS::UID::AutoCommit = 0;
4079   my $dbh = dbh;
4080
4081   my $part_pkg = new FS::part_pkg ( {
4082     'pkg'           => $pkg,
4083     'comment'       => $comment,
4084     'plan'          => 'flat',
4085     'freq'          => 0,
4086     'disabled'      => 'Y',
4087     'classnum'      => ( $classnum ? $classnum : '' ),
4088     'setuptax'      => $setuptax,
4089     'taxclass'      => $taxclass,
4090     'taxproductnum' => $taxproduct,
4091   } );
4092
4093   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
4094                         ( 0 .. @$additional - 1 )
4095                   ),
4096                   'additional_count' => scalar(@$additional),
4097                   'setup_fee' => $amount,
4098                 );
4099
4100   my $error = $part_pkg->insert( options       => \%options,
4101                                  tax_overrides => $override,
4102                                );
4103   if ( $error ) {
4104     $dbh->rollback if $oldAutoCommit;
4105     return $error;
4106   }
4107
4108   my $pkgpart = $part_pkg->pkgpart;
4109   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
4110   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
4111     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
4112     $error = $type_pkgs->insert;
4113     if ( $error ) {
4114       $dbh->rollback if $oldAutoCommit;
4115       return $error;
4116     }
4117   }
4118
4119   my $cust_pkg = new FS::cust_pkg ( {
4120     'custnum'    => $self->custnum,
4121     'pkgpart'    => $pkgpart,
4122     'quantity'   => $quantity,
4123     'start_date' => $start_date,
4124     'no_auto'    => $no_auto,
4125   } );
4126
4127   $error = $cust_pkg->insert;
4128   if ( $error ) {
4129     $dbh->rollback if $oldAutoCommit;
4130     return $error;
4131   } elsif ( $cust_pkg_ref ) {
4132     ${$cust_pkg_ref} = $cust_pkg;
4133   }
4134
4135   if ( $bill_now ) {
4136     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
4137                              'pkg_list'      => [ $cust_pkg ],
4138                            );
4139     if ( $error ) {
4140       $dbh->rollback if $oldAutoCommit;
4141       return $error;
4142     }
4143   }
4144
4145   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4146   return '';
4147
4148 }
4149
4150 #=item charge_postal_fee
4151 #
4152 #Applies a one time charge this customer.  If there is an error,
4153 #returns the error, returns the cust_pkg charge object or false
4154 #if there was no charge.
4155 #
4156 #=cut
4157 #
4158 # This should be a customer event.  For that to work requires that bill
4159 # also be a customer event.
4160
4161 sub charge_postal_fee {
4162   my $self = shift;
4163
4164   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
4165   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
4166
4167   my $cust_pkg = new FS::cust_pkg ( {
4168     'custnum'  => $self->custnum,
4169     'pkgpart'  => $pkgpart,
4170     'quantity' => 1,
4171   } );
4172
4173   my $error = $cust_pkg->insert;
4174   $error ? $error : $cust_pkg;
4175 }
4176
4177 =item cust_bill
4178
4179 Returns all the invoices (see L<FS::cust_bill>) for this customer.
4180
4181 =cut
4182
4183 sub cust_bill {
4184   my $self = shift;
4185   map { $_ } #return $self->num_cust_bill unless wantarray;
4186   sort { $a->_date <=> $b->_date }
4187     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
4188 }
4189
4190 =item open_cust_bill
4191
4192 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
4193 customer.
4194
4195 =cut
4196
4197 sub open_cust_bill {
4198   my $self = shift;
4199
4200   qsearch({
4201     'table'     => 'cust_bill',
4202     'hashref'   => { 'custnum' => $self->custnum, },
4203     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
4204     'order_by'  => 'ORDER BY _date ASC',
4205   });
4206
4207 }
4208
4209 =item cust_statements
4210
4211 Returns all the statements (see L<FS::cust_statement>) for this customer.
4212
4213 =cut
4214
4215 sub cust_statement {
4216   my $self = shift;
4217   map { $_ } #return $self->num_cust_statement unless wantarray;
4218   sort { $a->_date <=> $b->_date }
4219     qsearch('cust_statement', { 'custnum' => $self->custnum, } )
4220 }
4221
4222 =item cust_credit
4223
4224 Returns all the credits (see L<FS::cust_credit>) for this customer.
4225
4226 =cut
4227
4228 sub cust_credit {
4229   my $self = shift;
4230   map { $_ } #return $self->num_cust_credit unless wantarray;
4231   sort { $a->_date <=> $b->_date }
4232     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
4233 }
4234
4235 =item cust_credit_pkgnum
4236
4237 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
4238 package when using experimental package balances.
4239
4240 =cut
4241
4242 sub cust_credit_pkgnum {
4243   my( $self, $pkgnum ) = @_;
4244   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
4245   sort { $a->_date <=> $b->_date }
4246     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
4247                               'pkgnum'  => $pkgnum,
4248                             }
4249     );
4250 }
4251
4252 =item cust_pay
4253
4254 Returns all the payments (see L<FS::cust_pay>) for this customer.
4255
4256 =cut
4257
4258 sub cust_pay {
4259   my $self = shift;
4260   return $self->num_cust_pay unless wantarray;
4261   sort { $a->_date <=> $b->_date }
4262     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
4263 }
4264
4265 =item num_cust_pay
4266
4267 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
4268 called automatically when the cust_pay method is used in a scalar context.
4269
4270 =cut
4271
4272 sub num_cust_pay {
4273   my $self = shift;
4274   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
4275   my $sth = dbh->prepare($sql) or die dbh->errstr;
4276   $sth->execute($self->custnum) or die $sth->errstr;
4277   $sth->fetchrow_arrayref->[0];
4278 }
4279
4280 =item cust_pay_pkgnum
4281
4282 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
4283 package when using experimental package balances.
4284
4285 =cut
4286
4287 sub cust_pay_pkgnum {
4288   my( $self, $pkgnum ) = @_;
4289   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
4290   sort { $a->_date <=> $b->_date }
4291     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
4292                            'pkgnum'  => $pkgnum,
4293                          }
4294     );
4295 }
4296
4297 =item cust_pay_void
4298
4299 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
4300
4301 =cut
4302
4303 sub cust_pay_void {
4304   my $self = shift;
4305   map { $_ } #return $self->num_cust_pay_void unless wantarray;
4306   sort { $a->_date <=> $b->_date }
4307     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
4308 }
4309
4310 =item cust_pay_batch
4311
4312 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
4313
4314 =cut
4315
4316 sub cust_pay_batch {
4317   my $self = shift;
4318   map { $_ } #return $self->num_cust_pay_batch unless wantarray;
4319   sort { $a->paybatchnum <=> $b->paybatchnum }
4320     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
4321 }
4322
4323 =item cust_pay_pending
4324
4325 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
4326 (without status "done").
4327
4328 =cut
4329
4330 sub cust_pay_pending {
4331   my $self = shift;
4332   return $self->num_cust_pay_pending unless wantarray;
4333   sort { $a->_date <=> $b->_date }
4334     qsearch( 'cust_pay_pending', {
4335                                    'custnum' => $self->custnum,
4336                                    'status'  => { op=>'!=', value=>'done' },
4337                                  },
4338            );
4339 }
4340
4341 =item cust_pay_pending_attempt
4342
4343 Returns all payment attempts / declined payments for this customer, as pending
4344 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
4345 a corresponding payment (see L<FS::cust_pay>).
4346
4347 =cut
4348
4349 sub cust_pay_pending_attempt {
4350   my $self = shift;
4351   return $self->num_cust_pay_pending_attempt unless wantarray;
4352   sort { $a->_date <=> $b->_date }
4353     qsearch( 'cust_pay_pending', {
4354                                    'custnum' => $self->custnum,
4355                                    'status'  => 'done',
4356                                    'paynum'  => '',
4357                                  },
4358            );
4359 }
4360
4361 =item num_cust_pay_pending
4362
4363 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4364 customer (without status "done").  Also called automatically when the
4365 cust_pay_pending method is used in a scalar context.
4366
4367 =cut
4368
4369 sub num_cust_pay_pending {
4370   my $self = shift;
4371   $self->scalar_sql(
4372     " SELECT COUNT(*) FROM cust_pay_pending ".
4373       " WHERE custnum = ? AND status != 'done' ",
4374     $self->custnum
4375   );
4376 }
4377
4378 =item num_cust_pay_pending_attempt
4379
4380 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
4381 customer, with status "done" but without a corresp.  Also called automatically when the
4382 cust_pay_pending method is used in a scalar context.
4383
4384 =cut
4385
4386 sub num_cust_pay_pending_attempt {
4387   my $self = shift;
4388   $self->scalar_sql(
4389     " SELECT COUNT(*) FROM cust_pay_pending ".
4390       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
4391     $self->custnum
4392   );
4393 }
4394
4395 =item cust_refund
4396
4397 Returns all the refunds (see L<FS::cust_refund>) for this customer.
4398
4399 =cut
4400
4401 sub cust_refund {
4402   my $self = shift;
4403   map { $_ } #return $self->num_cust_refund unless wantarray;
4404   sort { $a->_date <=> $b->_date }
4405     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
4406 }
4407
4408 =item display_custnum
4409
4410 Returns the displayed customer number for this customer: agent_custid if
4411 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
4412
4413 =cut
4414
4415 sub display_custnum {
4416   my $self = shift;
4417   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
4418     return $self->agent_custid;
4419   } else {
4420     return $self->custnum;
4421   }
4422 }
4423
4424 =item name
4425
4426 Returns a name string for this customer, either "Company (Last, First)" or
4427 "Last, First".
4428
4429 =cut
4430
4431 sub name {
4432   my $self = shift;
4433   my $name = $self->contact;
4434   $name = $self->company. " ($name)" if $self->company;
4435   $name;
4436 }
4437
4438 =item ship_name
4439
4440 Returns a name string for this (service/shipping) contact, either
4441 "Company (Last, First)" or "Last, First".
4442
4443 =cut
4444
4445 sub ship_name {
4446   my $self = shift;
4447   if ( $self->get('ship_last') ) {
4448     my $name = $self->ship_contact;
4449     $name = $self->ship_company. " ($name)" if $self->ship_company;
4450     $name;
4451   } else {
4452     $self->name;
4453   }
4454 }
4455
4456 =item name_short
4457
4458 Returns a name string for this customer, either "Company" or "First Last".
4459
4460 =cut
4461
4462 sub name_short {
4463   my $self = shift;
4464   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4465 }
4466
4467 =item ship_name_short
4468
4469 Returns a name string for this (service/shipping) contact, either "Company"
4470 or "First Last".
4471
4472 =cut
4473
4474 sub ship_name_short {
4475   my $self = shift;
4476   if ( $self->get('ship_last') ) {
4477     $self->ship_company !~ /^\s*$/
4478       ? $self->ship_company
4479       : $self->ship_contact_firstlast;
4480   } else {
4481     $self->name_company_or_firstlast;
4482   }
4483 }
4484
4485 =item contact
4486
4487 Returns this customer's full (billing) contact name only, "Last, First"
4488
4489 =cut
4490
4491 sub contact {
4492   my $self = shift;
4493   $self->get('last'). ', '. $self->first;
4494 }
4495
4496 =item ship_contact
4497
4498 Returns this customer's full (shipping) contact name only, "Last, First"
4499
4500 =cut
4501
4502 sub ship_contact {
4503   my $self = shift;
4504   $self->get('ship_last')
4505     ? $self->get('ship_last'). ', '. $self->ship_first
4506     : $self->contact;
4507 }
4508
4509 =item contact_firstlast
4510
4511 Returns this customers full (billing) contact name only, "First Last".
4512
4513 =cut
4514
4515 sub contact_firstlast {
4516   my $self = shift;
4517   $self->first. ' '. $self->get('last');
4518 }
4519
4520 =item ship_contact_firstlast
4521
4522 Returns this customer's full (shipping) contact name only, "First Last".
4523
4524 =cut
4525
4526 sub ship_contact_firstlast {
4527   my $self = shift;
4528   $self->get('ship_last')
4529     ? $self->first. ' '. $self->get('ship_last')
4530     : $self->contact_firstlast;
4531 }
4532
4533 =item country_full
4534
4535 Returns this customer's full country name
4536
4537 =cut
4538
4539 sub country_full {
4540   my $self = shift;
4541   code2country($self->country);
4542 }
4543
4544 =item geocode DATA_VENDOR
4545
4546 Returns a value for the customer location as encoded by DATA_VENDOR.
4547 Currently this only makes sense for "CCH" as DATA_VENDOR.
4548
4549 =cut
4550
4551 sub geocode {
4552   my ($self, $data_vendor) = (shift, shift);  #always cch for now
4553
4554   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
4555   return $geocode if $geocode;
4556
4557   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
4558                ? 'ship_'
4559                : '';
4560
4561   my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
4562     if $self->country eq 'US';
4563
4564   $zip ||= '';
4565   $plus4 ||= '';
4566   #CCH specific location stuff
4567   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
4568
4569   my @cust_tax_location =
4570     qsearch( {
4571                'table'     => 'cust_tax_location',
4572                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
4573                'extra_sql' => $extra_sql,
4574                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
4575              }
4576            );
4577   $geocode = $cust_tax_location[0]->geocode
4578     if scalar(@cust_tax_location);
4579
4580   $geocode;
4581 }
4582
4583 =item cust_status
4584
4585 =item status
4586
4587 Returns a status string for this customer, currently:
4588
4589 =over 4
4590
4591 =item prospect - No packages have ever been ordered
4592
4593 =item ordered - Recurring packages all are new (not yet billed).
4594
4595 =item active - One or more recurring packages is active
4596
4597 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4598
4599 =item suspended - All non-cancelled recurring packages are suspended
4600
4601 =item cancelled - All recurring packages are cancelled
4602
4603 =back
4604
4605 =cut
4606
4607 sub status { shift->cust_status(@_); }
4608
4609 sub cust_status {
4610   my $self = shift;
4611   # prospect ordered active inactive suspended cancelled
4612   for my $status ( FS::cust_main->statuses() ) {
4613     my $method = $status.'_sql';
4614     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4615     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4616     $sth->execute( ($self->custnum) x $numnum )
4617       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4618     return $status if $sth->fetchrow_arrayref->[0];
4619   }
4620 }
4621
4622 =item ucfirst_cust_status
4623
4624 =item ucfirst_status
4625
4626 Returns the status with the first character capitalized.
4627
4628 =cut
4629
4630 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4631
4632 sub ucfirst_cust_status {
4633   my $self = shift;
4634   ucfirst($self->cust_status);
4635 }
4636
4637 =item statuscolor
4638
4639 Returns a hex triplet color string for this customer's status.
4640
4641 =cut
4642
4643 use vars qw(%statuscolor);
4644 tie %statuscolor, 'Tie::IxHash',
4645   'prospect'  => '7e0079', #'000000', #black?  naw, purple
4646   'active'    => '00CC00', #green
4647   'ordered'   => '009999', #teal? cyan?
4648   'inactive'  => '0000CC', #blue
4649   'suspended' => 'FF9900', #yellow
4650   'cancelled' => 'FF0000', #red
4651 ;
4652
4653 sub statuscolor { shift->cust_statuscolor(@_); }
4654
4655 sub cust_statuscolor {
4656   my $self = shift;
4657   $statuscolor{$self->cust_status};
4658 }
4659
4660 =item tickets
4661
4662 Returns an array of hashes representing the customer's RT tickets.
4663
4664 =cut
4665
4666 sub tickets {
4667   my $self = shift;
4668
4669   my $num = $conf->config('cust_main-max_tickets') || 10;
4670   my @tickets = ();
4671
4672   if ( $conf->config('ticket_system') ) {
4673     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4674
4675       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
4676
4677     } else {
4678
4679       foreach my $priority (
4680         $conf->config('ticket_system-custom_priority_field-values'), ''
4681       ) {
4682         last if scalar(@tickets) >= $num;
4683         push @tickets,
4684           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4685                                                  $num - scalar(@tickets),
4686                                                  $priority,
4687                                                )
4688            };
4689       }
4690     }
4691   }
4692   (@tickets);
4693 }
4694
4695 # Return services representing svc_accts in customer support packages
4696 sub support_services {
4697   my $self = shift;
4698   my %packages = map { $_ => 1 } $conf->config('support_packages');
4699
4700   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4701     grep { $_->part_svc->svcdb eq 'svc_acct' }
4702     map { $_->cust_svc }
4703     grep { exists $packages{ $_->pkgpart } }
4704     $self->ncancelled_pkgs;
4705
4706 }
4707
4708 # Return a list of latitude/longitude for one of the services (if any)
4709 sub service_coordinates {
4710   my $self = shift;
4711
4712   my @svc_X =
4713     grep { $_->latitude && $_->longitude }
4714     map { $_->svc_x }
4715     map { $_->cust_svc }
4716     $self->ncancelled_pkgs;
4717
4718   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4719 }
4720
4721 =item masked FIELD
4722
4723 Returns a masked version of the named field
4724
4725 =cut
4726
4727 sub masked {
4728 my ($self,$field) = @_;
4729
4730 # Show last four
4731
4732 'x'x(length($self->getfield($field))-4).
4733   substr($self->getfield($field), (length($self->getfield($field))-4));
4734
4735 }
4736
4737 =back
4738
4739 =head1 CLASS METHODS
4740
4741 =over 4
4742
4743 =item statuses
4744
4745 Class method that returns the list of possible status strings for customers
4746 (see L<the status method|/status>).  For example:
4747
4748   @statuses = FS::cust_main->statuses();
4749
4750 =cut
4751
4752 sub statuses {
4753   #my $self = shift; #could be class...
4754   keys %statuscolor;
4755 }
4756
4757 =item prospect_sql
4758
4759 Returns an SQL expression identifying prospective cust_main records (customers
4760 with no packages ever ordered)
4761
4762 =cut
4763
4764 use vars qw($select_count_pkgs);
4765 $select_count_pkgs =
4766   "SELECT COUNT(*) FROM cust_pkg
4767     WHERE cust_pkg.custnum = cust_main.custnum";
4768
4769 sub select_count_pkgs_sql {
4770   $select_count_pkgs;
4771 }
4772
4773 sub prospect_sql {
4774   " 0 = ( $select_count_pkgs ) ";
4775 }
4776
4777 =item ordered_sql
4778
4779 Returns an SQL expression identifying ordered cust_main records (customers with
4780 recurring packages not yet setup).
4781
4782 =cut
4783
4784 sub ordered_sql {
4785   FS::cust_main->none_active_sql.
4786   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
4787 }
4788
4789 =item active_sql
4790
4791 Returns an SQL expression identifying active cust_main records (customers with
4792 active recurring packages).
4793
4794 =cut
4795
4796 sub active_sql {
4797   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4798 }
4799
4800 =item none_active_sql
4801
4802 Returns an SQL expression identifying cust_main records with no active
4803 recurring packages.  This includes customers of status prospect, ordered,
4804 inactive, and suspended.
4805
4806 =cut
4807
4808 sub none_active_sql {
4809   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4810 }
4811
4812 =item inactive_sql
4813
4814 Returns an SQL expression identifying inactive cust_main records (customers with
4815 no active recurring packages, but otherwise unsuspended/uncancelled).
4816
4817 =cut
4818
4819 sub inactive_sql {
4820   FS::cust_main->none_active_sql.
4821   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4822 }
4823
4824 =item susp_sql
4825 =item suspended_sql
4826
4827 Returns an SQL expression identifying suspended cust_main records.
4828
4829 =cut
4830
4831
4832 sub suspended_sql { susp_sql(@_); }
4833 sub susp_sql {
4834   FS::cust_main->none_active_sql.
4835   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4836 }
4837
4838 =item cancel_sql
4839 =item cancelled_sql
4840
4841 Returns an SQL expression identifying cancelled cust_main records.
4842
4843 =cut
4844
4845 sub cancelled_sql { cancel_sql(@_); }
4846 sub cancel_sql {
4847
4848   my $recurring_sql = FS::cust_pkg->recurring_sql;
4849   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
4850
4851   "
4852         0 < ( $select_count_pkgs )
4853     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
4854     AND 0 = ( $select_count_pkgs AND $recurring_sql
4855                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4856             )
4857     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
4858   ";
4859
4860 }
4861
4862 =item uncancel_sql
4863 =item uncancelled_sql
4864
4865 Returns an SQL expression identifying un-cancelled cust_main records.
4866
4867 =cut
4868
4869 sub uncancelled_sql { uncancel_sql(@_); }
4870 sub uncancel_sql { "
4871   ( 0 < ( $select_count_pkgs
4872                    AND ( cust_pkg.cancel IS NULL
4873                          OR cust_pkg.cancel = 0
4874                        )
4875         )
4876     OR 0 = ( $select_count_pkgs )
4877   )
4878 "; }
4879
4880 =item balance_sql
4881
4882 Returns an SQL fragment to retreive the balance.
4883
4884 =cut
4885
4886 sub balance_sql { "
4887     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4888         WHERE cust_bill.custnum   = cust_main.custnum     )
4889   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4890         WHERE cust_pay.custnum    = cust_main.custnum     )
4891   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4892         WHERE cust_credit.custnum = cust_main.custnum     )
4893   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4894         WHERE cust_refund.custnum = cust_main.custnum     )
4895 "; }
4896
4897 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4898
4899 Returns an SQL fragment to retreive the balance for this customer, optionally
4900 considering invoices with date earlier than START_TIME, and not
4901 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4902 total_unapplied_payments).
4903
4904 Times are specified as SQL fragments or numeric
4905 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4906 L<Date::Parse> for conversion functions.  The empty string can be passed
4907 to disable that time constraint completely.
4908
4909 Available options are:
4910
4911 =over 4
4912
4913 =item unapplied_date
4914
4915 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)
4916
4917 =item total
4918
4919 (unused.  obsolete?)
4920 set to true to remove all customer comparison clauses, for totals
4921
4922 =item where
4923
4924 (unused.  obsolete?)
4925 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4926
4927 =item join
4928
4929 (unused.  obsolete?)
4930 JOIN clause (typically used with the total option)
4931
4932 =item cutoff
4933
4934 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4935 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4936 range for invoices and I<unapplied> payments, credits, and refunds.
4937
4938 =back
4939
4940 =cut
4941
4942 sub balance_date_sql {
4943   my( $class, $start, $end, %opt ) = @_;
4944
4945   my $cutoff = $opt{'cutoff'};
4946
4947   my $owed         = FS::cust_bill->owed_sql($cutoff);
4948   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4949   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4950   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4951
4952   my $j = $opt{'join'} || '';
4953
4954   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4955   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4956   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4957   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4958
4959   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4960     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4961     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4962     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4963   ";
4964
4965 }
4966
4967 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4968
4969 Returns an SQL fragment to retreive the total unapplied payments for this
4970 customer, only considering invoices with date earlier than START_TIME, and
4971 optionally not later than END_TIME.
4972
4973 Times are specified as SQL fragments or numeric
4974 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4975 L<Date::Parse> for conversion functions.  The empty string can be passed
4976 to disable that time constraint completely.
4977
4978 Available options are:
4979
4980 =cut
4981
4982 sub unapplied_payments_date_sql {
4983   my( $class, $start, $end, %opt ) = @_;
4984
4985   my $cutoff = $opt{'cutoff'};
4986
4987   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4988
4989   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4990                                                           'unapplied_date'=>1 );
4991
4992   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4993 }
4994
4995 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4996
4997 Helper method for balance_date_sql; name (and usage) subject to change
4998 (suggestions welcome).
4999
5000 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
5001 cust_refund, cust_credit or cust_pay).
5002
5003 If TABLE is "cust_bill" or the unapplied_date option is true, only
5004 considers records with date earlier than START_TIME, and optionally not
5005 later than END_TIME .
5006
5007 =cut
5008
5009 sub _money_table_where {
5010   my( $class, $table, $start, $end, %opt ) = @_;
5011
5012   my @where = ();
5013   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
5014   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
5015     push @where, "$table._date <= $start" if defined($start) && length($start);
5016     push @where, "$table._date >  $end"   if defined($end)   && length($end);
5017   }
5018   push @where, @{$opt{'where'}} if $opt{'where'};
5019   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
5020
5021   $where;
5022
5023 }
5024
5025 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
5026 use FS::cust_main::Search;
5027 sub search {
5028   my $class = shift;
5029   FS::cust_main::Search->search(@_);
5030 }
5031
5032 =back
5033
5034 =head1 SUBROUTINES
5035
5036 =over 4
5037
5038 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
5039
5040 =cut
5041
5042 sub append_fuzzyfiles {
5043   #my( $first, $last, $company ) = @_;
5044
5045   &check_and_rebuild_fuzzyfiles;
5046
5047   use Fcntl qw(:flock);
5048
5049   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
5050
5051   foreach my $field (@fuzzyfields) {
5052     my $value = shift;
5053
5054     if ( $value ) {
5055
5056       open(CACHE,">>$dir/cust_main.$field")
5057         or die "can't open $dir/cust_main.$field: $!";
5058       flock(CACHE,LOCK_EX)
5059         or die "can't lock $dir/cust_main.$field: $!";
5060
5061       print CACHE "$value\n";
5062
5063       flock(CACHE,LOCK_UN)
5064         or die "can't unlock $dir/cust_main.$field: $!";
5065       close CACHE;
5066     }
5067
5068   }
5069
5070   1;
5071 }
5072
5073 =item batch_charge
5074
5075 =cut
5076
5077 sub batch_charge {
5078   my $param = shift;
5079   #warn join('-',keys %$param);
5080   my $fh = $param->{filehandle};
5081   my $agentnum = $param->{agentnum};
5082   my $format = $param->{format};
5083
5084   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
5085
5086   my @fields;
5087   if ( $format eq 'simple' ) {
5088     @fields = qw( custnum agent_custid amount pkg );
5089   } else {
5090     die "unknown format $format";
5091   }
5092
5093   eval "use Text::CSV_XS;";
5094   die $@ if $@;
5095
5096   my $csv = new Text::CSV_XS;
5097   #warn $csv;
5098   #warn $fh;
5099
5100   my $imported = 0;
5101   #my $columns;
5102
5103   local $SIG{HUP} = 'IGNORE';
5104   local $SIG{INT} = 'IGNORE';
5105   local $SIG{QUIT} = 'IGNORE';
5106   local $SIG{TERM} = 'IGNORE';
5107   local $SIG{TSTP} = 'IGNORE';
5108   local $SIG{PIPE} = 'IGNORE';
5109
5110   my $oldAutoCommit = $FS::UID::AutoCommit;
5111   local $FS::UID::AutoCommit = 0;
5112   my $dbh = dbh;
5113
5114   #while ( $columns = $csv->getline($fh) ) {
5115   my $line;
5116   while ( defined($line=<$fh>) ) {
5117
5118     $csv->parse($line) or do {
5119       $dbh->rollback if $oldAutoCommit;
5120       return "can't parse: ". $csv->error_input();
5121     };
5122
5123     my @columns = $csv->fields();
5124     #warn join('-',@columns);
5125
5126     my %row = ();
5127     foreach my $field ( @fields ) {
5128       $row{$field} = shift @columns;
5129     }
5130
5131     if ( $row{custnum} && $row{agent_custid} ) {
5132       dbh->rollback if $oldAutoCommit;
5133       return "can't specify custnum with agent_custid $row{agent_custid}";
5134     }
5135
5136     my %hash = ();
5137     if ( $row{agent_custid} && $agentnum ) {
5138       %hash = ( 'agent_custid' => $row{agent_custid},
5139                 'agentnum'     => $agentnum,
5140               );
5141     }
5142
5143     if ( $row{custnum} ) {
5144       %hash = ( 'custnum' => $row{custnum} );
5145     }
5146
5147     unless ( scalar(keys %hash) ) {
5148       $dbh->rollback if $oldAutoCommit;
5149       return "can't find customer without custnum or agent_custid and agentnum";
5150     }
5151
5152     my $cust_main = qsearchs('cust_main', { %hash } );
5153     unless ( $cust_main ) {
5154       $dbh->rollback if $oldAutoCommit;
5155       my $custnum = $row{custnum} || $row{agent_custid};
5156       return "unknown custnum $custnum";
5157     }
5158
5159     if ( $row{'amount'} > 0 ) {
5160       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
5161       if ( $error ) {
5162         $dbh->rollback if $oldAutoCommit;
5163         return $error;
5164       }
5165       $imported++;
5166     } elsif ( $row{'amount'} < 0 ) {
5167       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
5168                                       $row{'pkg'}                         );
5169       if ( $error ) {
5170         $dbh->rollback if $oldAutoCommit;
5171         return $error;
5172       }
5173       $imported++;
5174     } else {
5175       #hmm?
5176     }
5177
5178   }
5179
5180   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5181
5182   return "Empty file!" unless $imported;
5183
5184   ''; #no error
5185
5186 }
5187
5188 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5189
5190 Deprecated.  Use event notification and message templates
5191 (L<FS::msg_template>) instead.
5192
5193 Sends a templated email notification to the customer (see L<Text::Template>).
5194
5195 OPTIONS is a hash and may include
5196
5197 I<from> - the email sender (default is invoice_from)
5198
5199 I<to> - comma-separated scalar or arrayref of recipients
5200    (default is invoicing_list)
5201
5202 I<subject> - The subject line of the sent email notification
5203    (default is "Notice from company_name")
5204
5205 I<extra_fields> - a hashref of name/value pairs which will be substituted
5206    into the template
5207
5208 The following variables are vavailable in the template.
5209
5210 I<$first> - the customer first name
5211 I<$last> - the customer last name
5212 I<$company> - the customer company
5213 I<$payby> - a description of the method of payment for the customer
5214             # would be nice to use FS::payby::shortname
5215 I<$payinfo> - the account information used to collect for this customer
5216 I<$expdate> - the expiration of the customer payment in seconds from epoch
5217
5218 =cut
5219
5220 sub notify {
5221   my ($self, $template, %options) = @_;
5222
5223   return unless $conf->exists($template);
5224
5225   my $from = $conf->config('invoice_from', $self->agentnum)
5226     if $conf->exists('invoice_from', $self->agentnum);
5227   $from = $options{from} if exists($options{from});
5228
5229   my $to = join(',', $self->invoicing_list_emailonly);
5230   $to = $options{to} if exists($options{to});
5231
5232   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
5233     if $conf->exists('company_name', $self->agentnum);
5234   $subject = $options{subject} if exists($options{subject});
5235
5236   my $notify_template = new Text::Template (TYPE => 'ARRAY',
5237                                             SOURCE => [ map "$_\n",
5238                                               $conf->config($template)]
5239                                            )
5240     or die "can't create new Text::Template object: Text::Template::ERROR";
5241   $notify_template->compile()
5242     or die "can't compile template: Text::Template::ERROR";
5243
5244   $FS::notify_template::_template::company_name =
5245     $conf->config('company_name', $self->agentnum);
5246   $FS::notify_template::_template::company_address =
5247     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
5248
5249   my $paydate = $self->paydate || '2037-12-31';
5250   $FS::notify_template::_template::first = $self->first;
5251   $FS::notify_template::_template::last = $self->last;
5252   $FS::notify_template::_template::company = $self->company;
5253   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
5254   my $payby = $self->payby;
5255   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5256   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5257
5258   #credit cards expire at the end of the month/year of their exp date
5259   if ($payby eq 'CARD' || $payby eq 'DCRD') {
5260     $FS::notify_template::_template::payby = 'credit card';
5261     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5262     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5263     $expire_time--;
5264   }elsif ($payby eq 'COMP') {
5265     $FS::notify_template::_template::payby = 'complimentary account';
5266   }else{
5267     $FS::notify_template::_template::payby = 'current method';
5268   }
5269   $FS::notify_template::_template::expdate = $expire_time;
5270
5271   for (keys %{$options{extra_fields}}){
5272     no strict "refs";
5273     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
5274   }
5275
5276   send_email(from => $from,
5277              to => $to,
5278              subject => $subject,
5279              body => $notify_template->fill_in( PACKAGE =>
5280                                                 'FS::notify_template::_template'                                              ),
5281             );
5282
5283 }
5284
5285 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
5286
5287 Generates a templated notification to the customer (see L<Text::Template>).
5288
5289 OPTIONS is a hash and may include
5290
5291 I<extra_fields> - a hashref of name/value pairs which will be substituted
5292    into the template.  These values may override values mentioned below
5293    and those from the customer record.
5294
5295 The following variables are available in the template instead of or in addition
5296 to the fields of the customer record.
5297
5298 I<$payby> - a description of the method of payment for the customer
5299             # would be nice to use FS::payby::shortname
5300 I<$payinfo> - the masked account information used to collect for this customer
5301 I<$expdate> - the expiration of the customer payment method in seconds from epoch
5302 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
5303
5304 =cut
5305
5306 # a lot like cust_bill::print_latex
5307 sub generate_letter {
5308   my ($self, $template, %options) = @_;
5309
5310   return unless $conf->exists($template);
5311
5312   my $letter_template = new Text::Template
5313                         ( TYPE       => 'ARRAY',
5314                           SOURCE     => [ map "$_\n", $conf->config($template)],
5315                           DELIMITERS => [ '[@--', '--@]' ],
5316                         )
5317     or die "can't create new Text::Template object: Text::Template::ERROR";
5318
5319   $letter_template->compile()
5320     or die "can't compile template: Text::Template::ERROR";
5321
5322   my %letter_data = map { $_ => $self->$_ } $self->fields;
5323   $letter_data{payinfo} = $self->mask_payinfo;
5324
5325   #my $paydate = $self->paydate || '2037-12-31';
5326   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
5327
5328   my $payby = $self->payby;
5329   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
5330   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
5331
5332   #credit cards expire at the end of the month/year of their exp date
5333   if ($payby eq 'CARD' || $payby eq 'DCRD') {
5334     $letter_data{payby} = 'credit card';
5335     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
5336     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
5337     $expire_time--;
5338   }elsif ($payby eq 'COMP') {
5339     $letter_data{payby} = 'complimentary account';
5340   }else{
5341     $letter_data{payby} = 'current method';
5342   }
5343   $letter_data{expdate} = $expire_time;
5344
5345   for (keys %{$options{extra_fields}}){
5346     $letter_data{$_} = $options{extra_fields}->{$_};
5347   }
5348
5349   unless(exists($letter_data{returnaddress})){
5350     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
5351                                                   $self->agent_template)
5352                      );
5353     if ( length($retadd) ) {
5354       $letter_data{returnaddress} = $retadd;
5355     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
5356       $letter_data{returnaddress} =
5357         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
5358                           s/$/\\\\\*/;
5359                           $_;
5360                         }
5361                     ( $conf->config('company_name', $self->agentnum),
5362                       $conf->config('company_address', $self->agentnum),
5363                     )
5364         );
5365     } else {
5366       $letter_data{returnaddress} = '~';
5367     }
5368   }
5369
5370   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
5371
5372   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
5373
5374   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
5375
5376   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5377                            DIR      => $dir,
5378                            SUFFIX   => '.eps',
5379                            UNLINK   => 0,
5380                          ) or die "can't open temp file: $!\n";
5381   print $lh $conf->config_binary('logo.eps', $self->agentnum)
5382     or die "can't write temp file: $!\n";
5383   close $lh;
5384   $letter_data{'logo_file'} = $lh->filename;
5385
5386   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
5387                            DIR      => $dir,
5388                            SUFFIX   => '.tex',
5389                            UNLINK   => 0,
5390                          ) or die "can't open temp file: $!\n";
5391
5392   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
5393   close $fh;
5394   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
5395   return ($1, $letter_data{'logo_file'});
5396
5397 }
5398
5399 =item print_ps TEMPLATE
5400
5401 Returns an postscript letter filled in from TEMPLATE, as a scalar.
5402
5403 =cut
5404
5405 sub print_ps {
5406   my $self = shift;
5407   my($file, $lfile) = $self->generate_letter(@_);
5408   my $ps = FS::Misc::generate_ps($file);
5409   unlink($file.'.tex');
5410   unlink($lfile);
5411
5412   $ps;
5413 }
5414
5415 =item print TEMPLATE
5416
5417 Prints the filled in template.
5418
5419 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5420
5421 =cut
5422
5423 sub queueable_print {
5424   my %opt = @_;
5425
5426   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5427     or die "invalid customer number: " . $opt{custvnum};
5428
5429   my $error = $self->print( $opt{template} );
5430   die $error if $error;
5431 }
5432
5433 sub print {
5434   my ($self, $template) = (shift, shift);
5435   do_print [ $self->print_ps($template) ];
5436 }
5437
5438 #these three subs should just go away once agent stuff is all config overrides
5439
5440 sub agent_template {
5441   my $self = shift;
5442   $self->_agent_plandata('agent_templatename');
5443 }
5444
5445 sub agent_invoice_from {
5446   my $self = shift;
5447   $self->_agent_plandata('agent_invoice_from');
5448 }
5449
5450 sub _agent_plandata {
5451   my( $self, $option ) = @_;
5452
5453   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
5454   #agent-specific Conf
5455
5456   use FS::part_event::Condition;
5457
5458   my $agentnum = $self->agentnum;
5459
5460   my $regexp = regexp_sql();
5461
5462   my $part_event_option =
5463     qsearchs({
5464       'select'    => 'part_event_option.*',
5465       'table'     => 'part_event_option',
5466       'addl_from' => q{
5467         LEFT JOIN part_event USING ( eventpart )
5468         LEFT JOIN part_event_option AS peo_agentnum
5469           ON ( part_event.eventpart = peo_agentnum.eventpart
5470                AND peo_agentnum.optionname = 'agentnum'
5471                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5472              )
5473         LEFT JOIN part_event_condition
5474           ON ( part_event.eventpart = part_event_condition.eventpart
5475                AND part_event_condition.conditionname = 'cust_bill_age'
5476              )
5477         LEFT JOIN part_event_condition_option
5478           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5479                AND part_event_condition_option.optionname = 'age'
5480              )
5481       },
5482       #'hashref'   => { 'optionname' => $option },
5483       #'hashref'   => { 'part_event_option.optionname' => $option },
5484       'extra_sql' =>
5485         " WHERE part_event_option.optionname = ". dbh->quote($option).
5486         " AND action = 'cust_bill_send_agent' ".
5487         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5488         " AND peo_agentnum.optionname = 'agentnum' ".
5489         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5490         " ORDER BY
5491            CASE WHEN part_event_condition_option.optionname IS NULL
5492            THEN -1
5493            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5494         " END
5495           , part_event.weight".
5496         " LIMIT 1"
5497     });
5498
5499   unless ( $part_event_option ) {
5500     return $self->agent->invoice_template || ''
5501       if $option eq 'agent_templatename';
5502     return '';
5503   }
5504
5505   $part_event_option->optionvalue;
5506
5507 }
5508
5509 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5510
5511 Subroutine (not a method), designed to be called from the queue.
5512
5513 Takes a list of options and values.
5514
5515 Pulls up the customer record via the custnum option and calls bill_and_collect.
5516
5517 =cut
5518
5519 sub queued_bill {
5520   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5521
5522   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5523   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5524
5525   $cust_main->bill_and_collect( %args );
5526 }
5527
5528 sub process_bill_and_collect {
5529   my $job = shift;
5530   my $param = thaw(decode_base64(shift));
5531   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5532       or die "custnum '$param->{custnum}' not found!\n";
5533   $param->{'job'}   = $job;
5534   $param->{'fatal'} = 1; # runs from job queue, will be caught
5535   $param->{'retry'} = 1;
5536
5537   $cust_main->bill_and_collect( %$param );
5538 }
5539
5540 sub _upgrade_data { #class method
5541   my ($class, %opts) = @_;
5542
5543   my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
5544   my $sth = dbh->prepare($sql) or die dbh->errstr;
5545   $sth->execute or die $sth->errstr;
5546
5547   local($ignore_expired_card) = 1;
5548   local($ignore_illegal_zip) = 1;
5549   local($skip_fuzzyfiles) = 1;
5550   $class->_upgrade_otaker(%opts);
5551
5552 }
5553
5554 =back
5555
5556 =head1 BUGS
5557
5558 The delete method.
5559
5560 The delete method should possibly take an FS::cust_main object reference
5561 instead of a scalar customer number.
5562
5563 Bill and collect options should probably be passed as references instead of a
5564 list.
5565
5566 There should probably be a configuration file with a list of allowed credit
5567 card types.
5568
5569 No multiple currency support (probably a larger project than just this module).
5570
5571 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5572
5573 Birthdates rely on negative epoch values.
5574
5575 The payby for card/check batches is broken.  With mixed batching, bad
5576 things will happen.
5577
5578 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5579
5580 =head1 SEE ALSO
5581
5582 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5583 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5584 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5585
5586 =cut
5587
5588 1;
5589