FS/FS/cust_main.pm

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