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   ;
1419
1420   #barf.  need message catalogs.  i18n.  etc.
1421   $error .= "Please select an advertising source."
1422     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1423   return $error if $error;
1424
1425   return "Unknown agent"
1426     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1427
1428   return "Unknown refnum"
1429     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1430
1431   return "Unknown referring custnum: ". $self->referral_custnum
1432     unless ! $self->referral_custnum
1433            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1434
1435   if ( $self->censustract ne '' ) {
1436     $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1437       or return "Illegal census tract: ". $self->censustract;
1438
1439     $self->censustract("$1.$2");
1440   }
1441
1442   if ( $self->ss eq '' ) {
1443     $self->ss('');
1444   } else {
1445     my $ss = $self->ss;
1446     $ss =~ s/\D//g;
1447     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1448       or return "Illegal social security number: ". $self->ss;
1449     $self->ss("$1-$2-$3");
1450   }
1451
1452
1453 # bad idea to disable, causes billing to fail because of no tax rates later
1454 # except we don't fail any more
1455   unless ( $import ) {
1456     unless ( qsearch('cust_main_county', {
1457       'country' => $self->country,
1458       'state'   => '',
1459      } ) ) {
1460       return "Unknown state/county/country: ".
1461         $self->state. "/". $self->county. "/". $self->country
1462         unless qsearch('cust_main_county',{
1463           'state'   => $self->state,
1464           'county'  => $self->county,
1465           'country' => $self->country,
1466         } );
1467     }
1468   }
1469
1470   $error =
1471     $self->ut_phonen('daytime', $self->country)
1472     || $self->ut_phonen('night', $self->country)
1473     || $self->ut_phonen('fax', $self->country)
1474   ;
1475   return $error if $error;
1476
1477   unless ( $ignore_illegal_zip ) {
1478     $error = $self->ut_zip('zip', $self->country);
1479     return $error if $error;
1480   }
1481
1482   if ( $conf->exists('cust_main-require_phone')
1483        && ! length($self->daytime) && ! length($self->night)
1484      ) {
1485
1486     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1487                           ? 'Day Phone'
1488                           : FS::Msgcat::_gettext('daytime');
1489     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1490                         ? 'Night Phone'
1491                         : FS::Msgcat::_gettext('night');
1492
1493     return "$daytime_label or $night_label is required"
1494
1495   }
1496
1497   if ( $self->has_ship_address
1498        && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1499                         $self->addr_fields )
1500      )
1501   {
1502     my $error =
1503       $self->ut_name('ship_last')
1504       || $self->ut_name('ship_first')
1505       || $self->ut_textn('ship_company')
1506       || $self->ut_text('ship_address1')
1507       || $self->ut_textn('ship_address2')
1508       || $self->ut_text('ship_city')
1509       || $self->ut_textn('ship_county')
1510       || $self->ut_textn('ship_state')
1511       || $self->ut_country('ship_country')
1512     ;
1513     return $error if $error;
1514
1515     #false laziness with above
1516     unless ( qsearchs('cust_main_county', {
1517       'country' => $self->ship_country,
1518       'state'   => '',
1519      } ) ) {
1520       return "Unknown ship_state/ship_county/ship_country: ".
1521         $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1522         unless qsearch('cust_main_county',{
1523           'state'   => $self->ship_state,
1524           'county'  => $self->ship_county,
1525           'country' => $self->ship_country,
1526         } );
1527     }
1528     #eofalse
1529
1530     $error =
1531       $self->ut_phonen('ship_daytime', $self->ship_country)
1532       || $self->ut_phonen('ship_night', $self->ship_country)
1533       || $self->ut_phonen('ship_fax', $self->ship_country)
1534     ;
1535     return $error if $error;
1536
1537     unless ( $ignore_illegal_zip ) {
1538       $error = $self->ut_zip('ship_zip', $self->ship_country);
1539       return $error if $error;
1540     }
1541     return "Unit # is required."
1542       if $self->ship_address2 =~ /^\s*$/
1543       && $conf->exists('cust_main-require_address2');
1544
1545   } else { # ship_ info eq billing info, so don't store dup info in database
1546
1547     $self->setfield("ship_$_", '')
1548       foreach $self->addr_fields;
1549
1550     return "Unit # is required."
1551       if $self->address2 =~ /^\s*$/
1552       && $conf->exists('cust_main-require_address2');
1553
1554   }
1555
1556   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1557   #  or return "Illegal payby: ". $self->payby;
1558   #$self->payby($1);
1559   FS::payby->can_payby($self->table, $self->payby)
1560     or return "Illegal payby: ". $self->payby;
1561
1562   $error =    $self->ut_numbern('paystart_month')
1563            || $self->ut_numbern('paystart_year')
1564            || $self->ut_numbern('payissue')
1565            || $self->ut_textn('paytype')
1566   ;
1567   return $error if $error;
1568
1569   if ( $self->payip eq '' ) {
1570     $self->payip('');
1571   } else {
1572     $error = $self->ut_ip('payip');
1573     return $error if $error;
1574   }
1575
1576   # If it is encrypted and the private key is not availaible then we can't
1577   # check the credit card.
1578   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1579
1580   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1581
1582     my $payinfo = $self->payinfo;
1583     $payinfo =~ s/\D//g;
1584     $payinfo =~ /^(\d{13,16})$/
1585       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1586     $payinfo = $1;
1587     $self->payinfo($payinfo);
1588     validate($payinfo)
1589       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1590
1591     return gettext('unknown_card_type')
1592       if $self->payinfo !~ /^99\d{14}$/ #token
1593       && cardtype($self->payinfo) eq "Unknown";
1594
1595     unless ( $ignore_banned_card ) {
1596       my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1597       if ( $ban ) {
1598         return 'Banned credit card: banned on '.
1599                time2str('%a %h %o at %r', $ban->_date).
1600                ' by '. $ban->otaker.
1601                ' (ban# '. $ban->bannum. ')';
1602       }
1603     }
1604
1605     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1606       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1607         $self->paycvv =~ /^(\d{4})$/
1608           or return "CVV2 (CID) for American Express cards is four digits.";
1609         $self->paycvv($1);
1610       } else {
1611         $self->paycvv =~ /^(\d{3})$/
1612           or return "CVV2 (CVC2/CID) is three digits.";
1613         $self->paycvv($1);
1614       }
1615     } else {
1616       $self->paycvv('');
1617     }
1618
1619     my $cardtype = cardtype($payinfo);
1620     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1621
1622       return "Start date or issue number is required for $cardtype cards"
1623         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1624
1625       return "Start month must be between 1 and 12"
1626         if $self->paystart_month
1627            and $self->paystart_month < 1 || $self->paystart_month > 12;
1628
1629       return "Start year must be 1990 or later"
1630         if $self->paystart_year
1631            and $self->paystart_year < 1990;
1632
1633       return "Issue number must be beween 1 and 99"
1634         if $self->payissue
1635           and $self->payissue < 1 || $self->payissue > 99;
1636
1637     } else {
1638       $self->paystart_month('');
1639       $self->paystart_year('');
1640       $self->payissue('');
1641     }
1642
1643   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1644
1645     my $payinfo = $self->payinfo;
1646     $payinfo =~ s/[^\d\@]//g;
1647     if ( $conf->exists('echeck-nonus') ) {
1648       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1649       $payinfo = "$1\@$2";
1650     } else {
1651       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1652       $payinfo = "$1\@$2";
1653     }
1654     $self->payinfo($payinfo);
1655     $self->paycvv('');
1656
1657     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1658     if ( $ban ) {
1659       return 'Banned ACH account: banned on '.
1660              time2str('%a %h %o at %r', $ban->_date).
1661              ' by '. $ban->otaker.
1662              ' (ban# '. $ban->bannum. ')';
1663     }
1664
1665   } elsif ( $self->payby eq 'LECB' ) {
1666
1667     my $payinfo = $self->payinfo;
1668     $payinfo =~ s/\D//g;
1669     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1670     $payinfo = $1;
1671     $self->payinfo($payinfo);
1672     $self->paycvv('');
1673
1674   } elsif ( $self->payby eq 'BILL' ) {
1675
1676     $error = $self->ut_textn('payinfo');
1677     return "Illegal P.O. number: ". $self->payinfo if $error;
1678     $self->paycvv('');
1679
1680   } elsif ( $self->payby eq 'COMP' ) {
1681
1682     my $curuser = $FS::CurrentUser::CurrentUser;
1683     if (    ! $self->custnum
1684          && ! $curuser->access_right('Complimentary customer')
1685        )
1686     {
1687       return "You are not permitted to create complimentary accounts."
1688     }
1689
1690     $error = $self->ut_textn('payinfo');
1691     return "Illegal comp account issuer: ". $self->payinfo if $error;
1692     $self->paycvv('');
1693
1694   } elsif ( $self->payby eq 'PREPAY' ) {
1695
1696     my $payinfo = $self->payinfo;
1697     $payinfo =~ s/\W//g; #anything else would just confuse things
1698     $self->payinfo($payinfo);
1699     $error = $self->ut_alpha('payinfo');
1700     return "Illegal prepayment identifier: ". $self->payinfo if $error;
1701     return "Unknown prepayment identifier"
1702       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
1703     $self->paycvv('');
1704
1705   }
1706
1707   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
1708     return "Expiration date required"
1709       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
1710     $self->paydate('');
1711   } else {
1712     my( $m, $y );
1713     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
1714       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
1715     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1716       ( $m, $y ) = ( $2, "19$1" );
1717     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
1718       ( $m, $y ) = ( $3, "20$2" );
1719     } else {
1720       return "Illegal expiration date: ". $self->paydate;
1721     }
1722     $self->paydate("$y-$m-01");
1723     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
1724     return gettext('expired_card')
1725       if !$import
1726       && !$ignore_expired_card
1727       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
1728   }
1729
1730   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
1731        ( ! $conf->exists('require_cardname')
1732          || $self->payby !~ /^(CARD|DCRD)$/  )
1733   ) {
1734     $self->payname( $self->first. " ". $self->getfield('last') );
1735   } else {
1736     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
1737       or return gettext('illegal_name'). " payname: ". $self->payname;
1738     $self->payname($1);
1739   }
1740
1741   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
1742     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
1743     $self->$flag($1);
1744   }
1745
1746   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
1747
1748   warn "$me check AFTER: \n". $self->_dump
1749     if $DEBUG > 2;
1750
1751   $self->SUPER::check;
1752 }
1753
1754 =item addr_fields
1755
1756 Returns a list of fields which have ship_ duplicates.
1757
1758 =cut
1759
1760 sub addr_fields {
1761   qw( last first company
1762       address1 address2 city county state zip country
1763       daytime night fax
1764     );
1765 }
1766
1767 =item has_ship_address
1768
1769 Returns true if this customer record has a separate shipping address.
1770
1771 =cut
1772
1773 sub has_ship_address {
1774   my $self = shift;
1775   scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
1776 }
1777
1778 =item location_hash
1779
1780 Returns a list of key/value pairs, with the following keys: address1, adddress2,
1781 city, county, state, zip, country.  The shipping address is used if present.
1782
1783 =cut
1784
1785 #geocode?  dependent on tax-ship_address config, not available in cust_location
1786 #mostly.  not yet then.
1787
1788 sub location_hash {
1789   my $self = shift;
1790   my $prefix = $self->has_ship_address ? 'ship_' : '';
1791
1792   map { $_ => $self->get($prefix.$_) }
1793       qw( address1 address2 city county state zip country geocode );
1794       #fields that cust_location has
1795 }
1796
1797 =item cust_location
1798
1799 Returns all locations (see L<FS::cust_location>) for this customer.
1800
1801 =cut
1802
1803 sub cust_location {
1804   my $self = shift;
1805   qsearch('cust_location', { 'custnum' => $self->custnum } );
1806 }
1807
1808 =item location_label [ OPTION => VALUE ... ]
1809
1810 Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
1811
1812 Options are
1813
1814 =over 4
1815
1816 =item join_string
1817
1818 used to separate the address elements (defaults to ', ')
1819
1820 =item escape_function
1821
1822 a callback used for escaping the text of the address elements
1823
1824 =back
1825
1826 =cut
1827
1828 # false laziness with FS::cust_location::line
1829
1830 sub location_label {
1831   my $self = shift;
1832   my %opt = @_;
1833
1834   my $separator = $opt{join_string} || ', ';
1835   my $escape = $opt{escape_function} || sub{ shift };
1836   my $line = '';
1837   my $cydefault = FS::conf->new->config('countrydefault') || 'US';
1838   my $prefix = length($self->ship_last) ? 'ship_' : '';
1839
1840   my $notfirst = 0;
1841   foreach (qw ( address1 address2 ) ) {
1842     my $method = "$prefix$_";
1843     $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
1844       if $self->$method;
1845     $notfirst++;
1846   }
1847   $notfirst = 0;
1848   foreach (qw ( city county state zip ) ) {
1849     my $method = "$prefix$_";
1850     if ( $self->$method ) {
1851       $line .= ' (' if $method eq 'county';
1852       $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
1853       $line .= ' )' if $method eq 'county';
1854       $notfirst++;
1855     }
1856   }
1857   $line .= $separator. &$escape(code2country($self->country))
1858     if $self->country ne $cydefault;
1859
1860   $line;
1861 }
1862
1863 =item unsuspend
1864
1865 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
1866 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
1867 on success or a list of errors.
1868
1869 =cut
1870
1871 sub unsuspend {
1872   my $self = shift;
1873   grep { $_->unsuspend } $self->suspended_pkgs;
1874 }
1875
1876 =item suspend
1877
1878 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
1879
1880 Returns a list: an empty list on success or a list of errors.
1881
1882 =cut
1883
1884 sub suspend {
1885   my $self = shift;
1886   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
1887 }
1888
1889 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1890
1891 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
1892 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
1893 of a list of pkgparts; the hashref has the following keys:
1894
1895 =over 4
1896
1897 =item pkgparts - listref of pkgparts
1898
1899 =item (other options are passed to the suspend method)
1900
1901 =back
1902
1903
1904 Returns a list: an empty list on success or a list of errors.
1905
1906 =cut
1907
1908 sub suspend_if_pkgpart {
1909   my $self = shift;
1910   my (@pkgparts, %opt);
1911   if (ref($_[0]) eq 'HASH'){
1912     @pkgparts = @{$_[0]{pkgparts}};
1913     %opt      = %{$_[0]};
1914   }else{
1915     @pkgparts = @_;
1916   }
1917   grep { $_->suspend(%opt) }
1918     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
1919       $self->unsuspended_pkgs;
1920 }
1921
1922 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
1923
1924 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
1925 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
1926 instead of a list of pkgparts; the hashref has the following keys:
1927
1928 =over 4
1929
1930 =item pkgparts - listref of pkgparts
1931
1932 =item (other options are passed to the suspend method)
1933
1934 =back
1935
1936 Returns a list: an empty list on success or a list of errors.
1937
1938 =cut
1939
1940 sub suspend_unless_pkgpart {
1941   my $self = shift;
1942   my (@pkgparts, %opt);
1943   if (ref($_[0]) eq 'HASH'){
1944     @pkgparts = @{$_[0]{pkgparts}};
1945     %opt      = %{$_[0]};
1946   }else{
1947     @pkgparts = @_;
1948   }
1949   grep { $_->suspend(%opt) }
1950     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
1951       $self->unsuspended_pkgs;
1952 }
1953
1954 =item cancel [ OPTION => VALUE ... ]
1955
1956 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
1957
1958 Available options are:
1959
1960 =over 4
1961
1962 =item quiet - can be set true to supress email cancellation notices.
1963
1964 =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.
1965
1966 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
1967
1968 =item nobill - can be set true to skip billing if it might otherwise be done.
1969
1970 =back
1971
1972 Always returns a list: an empty list on success or a list of errors.
1973
1974 =cut
1975
1976 # nb that dates are not specified as valid options to this method
1977
1978 sub cancel {
1979   my( $self, %opt ) = @_;
1980
1981   warn "$me cancel called on customer ". $self->custnum. " with options ".
1982        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
1983     if $DEBUG;
1984
1985   return ( 'access denied' )
1986     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
1987
1988   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
1989
1990     #should try decryption (we might have the private key)
1991     # and if not maybe queue a job for the server that does?
1992     return ( "Can't (yet) ban encrypted credit cards" )
1993       if $self->is_encrypted($self->payinfo);
1994
1995     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
1996     my $error = $ban->insert;
1997     return ( $error ) if $error;
1998
1999   }
2000
2001   my @pkgs = $self->ncancelled_pkgs;
2002
2003   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2004     $opt{nobill} = 1;
2005     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2006     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2007       if $error;
2008   }
2009
2010   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2011        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2012     if $DEBUG;
2013
2014   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2015 }
2016
2017 sub _banned_pay_hashref {
2018   my $self = shift;
2019
2020   my %payby2ban = (
2021     'CARD' => 'CARD',
2022     'DCRD' => 'CARD',
2023     'CHEK' => 'CHEK',
2024     'DCHK' => 'CHEK'
2025   );
2026
2027   {
2028     'payby'   => $payby2ban{$self->payby},
2029     'payinfo' => md5_base64($self->payinfo),
2030     #don't ever *search* on reason! #'reason'  =>
2031   };
2032 }
2033
2034 =item notes
2035
2036 Returns all notes (see L<FS::cust_main_note>) for this customer.
2037
2038 =cut
2039
2040 sub notes {
2041   my $self = shift;
2042   #order by?
2043   qsearch( 'cust_main_note',
2044            { 'custnum' => $self->custnum },
2045            '',
2046            'ORDER BY _DATE DESC'
2047          );
2048 }
2049
2050 =item agent
2051
2052 Returns the agent (see L<FS::agent>) for this customer.
2053
2054 =cut
2055
2056 sub agent {
2057   my $self = shift;
2058   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2059 }
2060
2061 =item agent_name
2062
2063 Returns the agent name (see L<FS::agent>) for this customer.
2064
2065 =cut
2066
2067 sub agent_name {
2068   my $self = shift;
2069   $self->agent->agent;
2070 }
2071
2072 =item cust_tag
2073
2074 Returns any tags associated with this customer, as FS::cust_tag objects,
2075 or an empty list if there are no tags.
2076
2077 =cut
2078
2079 sub cust_tag {
2080   my $self = shift;
2081   qsearch('cust_tag', { 'custnum' => $self->custnum } );
2082 }
2083
2084 =item part_tag
2085
2086 Returns any tags associated with this customer, as FS::part_tag objects,
2087 or an empty list if there are no tags.
2088
2089 =cut
2090
2091 sub part_tag {
2092   my $self = shift;
2093   map $_->part_tag, $self->cust_tag;
2094 }
2095
2096
2097 =item cust_class
2098
2099 Returns the customer class, as an FS::cust_class object, or the empty string
2100 if there is no customer class.
2101
2102 =cut
2103
2104 sub cust_class {
2105   my $self = shift;
2106   if ( $self->classnum ) {
2107     qsearchs('cust_class', { 'classnum' => $self->classnum } );
2108   } else {
2109     return '';
2110   }
2111 }
2112
2113 =item categoryname
2114
2115 Returns the customer category name, or the empty string if there is no customer
2116 category.
2117
2118 =cut
2119
2120 sub categoryname {
2121   my $self = shift;
2122   my $cust_class = $self->cust_class;
2123   $cust_class
2124     ? $cust_class->categoryname
2125     : '';
2126 }
2127
2128 =item classname
2129
2130 Returns the customer class name, or the empty string if there is no customer
2131 class.
2132
2133 =cut
2134
2135 sub classname {
2136   my $self = shift;
2137   my $cust_class = $self->cust_class;
2138   $cust_class
2139     ? $cust_class->classname
2140     : '';
2141 }
2142
2143 =item BILLING METHODS
2144
2145 Documentation on billing methods has been moved to
2146 L<FS::cust_main::Billing>.
2147
2148 =item REALTIME BILLING METHODS
2149
2150 Documentation on realtime billing methods has been moved to
2151 L<FS::cust_main::Billing_Realtime>.
2152
2153 =item remove_cvv
2154
2155 Removes the I<paycvv> field from the database directly.
2156
2157 If there is an error, returns the error, otherwise returns false.
2158
2159 =cut
2160
2161 sub remove_cvv {
2162   my $self = shift;
2163   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2164     or return dbh->errstr;
2165   $sth->execute($self->custnum)
2166     or return $sth->errstr;
2167   $self->paycvv('');
2168   '';
2169 }
2170
2171 =item batch_card OPTION => VALUE...
2172
2173 Adds a payment for this invoice to the pending credit card batch (see
2174 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2175 runs the payment using a realtime gateway.
2176
2177 =cut
2178
2179 sub batch_card {
2180   my ($self, %options) = @_;
2181
2182   my $amount;
2183   if (exists($options{amount})) {
2184     $amount = $options{amount};
2185   }else{
2186     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2187   }
2188   return '' unless $amount > 0;
2189
2190   my $invnum = delete $options{invnum};
2191   my $payby = $options{invnum} || $self->payby;  #dubious
2192
2193   if ($options{'realtime'}) {
2194     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2195                                 $amount,
2196                                 %options,
2197                               );
2198   }
2199
2200   my $oldAutoCommit = $FS::UID::AutoCommit;
2201   local $FS::UID::AutoCommit = 0;
2202   my $dbh = dbh;
2203
2204   #this needs to handle mysql as well as Pg, like svc_acct.pm
2205   #(make it into a common function if folks need to do batching with mysql)
2206   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2207     or return "Cannot lock pay_batch: " . $dbh->errstr;
2208
2209   my %pay_batch = (
2210     'status' => 'O',
2211     'payby'  => FS::payby->payby2payment($payby),
2212   );
2213
2214   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2215
2216   unless ( $pay_batch ) {
2217     $pay_batch = new FS::pay_batch \%pay_batch;
2218     my $error = $pay_batch->insert;
2219     if ( $error ) {
2220       $dbh->rollback if $oldAutoCommit;
2221       die "error creating new batch: $error\n";
2222     }
2223   }
2224
2225   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2226       'batchnum' => $pay_batch->batchnum,
2227       'custnum'  => $self->custnum,
2228   } );
2229
2230   foreach (qw( address1 address2 city state zip country payby payinfo paydate
2231                payname )) {
2232     $options{$_} = '' unless exists($options{$_});
2233   }
2234
2235   my $cust_pay_batch = new FS::cust_pay_batch ( {
2236     'batchnum' => $pay_batch->batchnum,
2237     'invnum'   => $invnum || 0,                    # is there a better value?
2238                                                    # this field should be
2239                                                    # removed...
2240                                                    # cust_bill_pay_batch now
2241     'custnum'  => $self->custnum,
2242     'last'     => $self->getfield('last'),
2243     'first'    => $self->getfield('first'),
2244     'address1' => $options{address1} || $self->address1,
2245     'address2' => $options{address2} || $self->address2,
2246     'city'     => $options{city}     || $self->city,
2247     'state'    => $options{state}    || $self->state,
2248     'zip'      => $options{zip}      || $self->zip,
2249     'country'  => $options{country}  || $self->country,
2250     'payby'    => $options{payby}    || $self->payby,
2251     'payinfo'  => $options{payinfo}  || $self->payinfo,
2252     'exp'      => $options{paydate}  || $self->paydate,
2253     'payname'  => $options{payname}  || $self->payname,
2254     'amount'   => $amount,                         # consolidating
2255   } );
2256
2257   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2258     if $old_cust_pay_batch;
2259
2260   my $error;
2261   if ($old_cust_pay_batch) {
2262     $error = $cust_pay_batch->replace($old_cust_pay_batch)
2263   } else {
2264     $error = $cust_pay_batch->insert;
2265   }
2266
2267   if ( $error ) {
2268     $dbh->rollback if $oldAutoCommit;
2269     die $error;
2270   }
2271
2272   my $unapplied =   $self->total_unapplied_credits
2273                   + $self->total_unapplied_payments
2274                   + $self->in_transit_payments;
2275   foreach my $cust_bill ($self->open_cust_bill) {
2276     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2277     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2278       'invnum' => $cust_bill->invnum,
2279       'paybatchnum' => $cust_pay_batch->paybatchnum,
2280       'amount' => $cust_bill->owed,
2281       '_date' => time,
2282     };
2283     if ($unapplied >= $cust_bill_pay_batch->amount){
2284       $unapplied -= $cust_bill_pay_batch->amount;
2285       next;
2286     }else{
2287       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2288                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
2289     }
2290     $error = $cust_bill_pay_batch->insert;
2291     if ( $error ) {
2292       $dbh->rollback if $oldAutoCommit;
2293       die $error;
2294     }
2295   }
2296
2297   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2298   '';
2299 }
2300
2301 =item total_owed
2302
2303 Returns the total owed for this customer on all invoices
2304 (see L<FS::cust_bill/owed>).
2305
2306 =cut
2307
2308 sub total_owed {
2309   my $self = shift;
2310   $self->total_owed_date(2145859200); #12/31/2037
2311 }
2312
2313 =item total_owed_date TIME
2314
2315 Returns the total owed for this customer on all invoices with date earlier than
2316 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2317 see L<Time::Local> and L<Date::Parse> for conversion functions.
2318
2319 =cut
2320
2321 sub total_owed_date {
2322   my $self = shift;
2323   my $time = shift;
2324
2325   my $custnum = $self->custnum;
2326
2327   my $owed_sql = FS::cust_bill->owed_sql;
2328
2329   my $sql = "
2330     SELECT SUM($owed_sql) FROM cust_bill
2331       WHERE custnum = $custnum
2332         AND _date <= $time
2333   ";
2334
2335   sprintf( "%.2f", $self->scalar_sql($sql) );
2336
2337 }
2338
2339 =item total_owed_pkgnum PKGNUM
2340
2341 Returns the total owed on all invoices for this customer's specific package
2342 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2343
2344 =cut
2345
2346 sub total_owed_pkgnum {
2347   my( $self, $pkgnum ) = @_;
2348   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2349 }
2350
2351 =item total_owed_date_pkgnum TIME PKGNUM
2352
2353 Returns the total owed for this customer's specific package when using
2354 experimental package balances on all invoices with date earlier than
2355 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2356 see L<Time::Local> and L<Date::Parse> for conversion functions.
2357
2358 =cut
2359
2360 sub total_owed_date_pkgnum {
2361   my( $self, $time, $pkgnum ) = @_;
2362
2363   my $total_bill = 0;
2364   foreach my $cust_bill (
2365     grep { $_->_date <= $time }
2366       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2367   ) {
2368     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2369   }
2370   sprintf( "%.2f", $total_bill );
2371
2372 }
2373
2374 =item total_paid
2375
2376 Returns the total amount of all payments.
2377
2378 =cut
2379
2380 sub total_paid {
2381   my $self = shift;
2382   my $total = 0;
2383   $total += $_->paid foreach $self->cust_pay;
2384   sprintf( "%.2f", $total );
2385 }
2386
2387 =item total_unapplied_credits
2388
2389 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2390 customer.  See L<FS::cust_credit/credited>.
2391
2392 =item total_credited
2393
2394 Old name for total_unapplied_credits.  Don't use.
2395
2396 =cut
2397
2398 sub total_credited {
2399   #carp "total_credited deprecated, use total_unapplied_credits";
2400   shift->total_unapplied_credits(@_);
2401 }
2402
2403 sub total_unapplied_credits {
2404   my $self = shift;
2405
2406   my $custnum = $self->custnum;
2407
2408   my $unapplied_sql = FS::cust_credit->unapplied_sql;
2409
2410   my $sql = "
2411     SELECT SUM($unapplied_sql) FROM cust_credit
2412       WHERE custnum = $custnum
2413   ";
2414
2415   sprintf( "%.2f", $self->scalar_sql($sql) );
2416
2417 }
2418
2419 =item total_unapplied_credits_pkgnum PKGNUM
2420
2421 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2422 customer.  See L<FS::cust_credit/credited>.
2423
2424 =cut
2425
2426 sub total_unapplied_credits_pkgnum {
2427   my( $self, $pkgnum ) = @_;
2428   my $total_credit = 0;
2429   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2430   sprintf( "%.2f", $total_credit );
2431 }
2432
2433
2434 =item total_unapplied_payments
2435
2436 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2437 See L<FS::cust_pay/unapplied>.
2438
2439 =cut
2440
2441 sub total_unapplied_payments {
2442   my $self = shift;
2443
2444   my $custnum = $self->custnum;
2445
2446   my $unapplied_sql = FS::cust_pay->unapplied_sql;
2447
2448   my $sql = "
2449     SELECT SUM($unapplied_sql) FROM cust_pay
2450       WHERE custnum = $custnum
2451   ";
2452
2453   sprintf( "%.2f", $self->scalar_sql($sql) );
2454
2455 }
2456
2457 =item total_unapplied_payments_pkgnum PKGNUM
2458
2459 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2460 specific package when using experimental package balances.  See
2461 L<FS::cust_pay/unapplied>.
2462
2463 =cut
2464
2465 sub total_unapplied_payments_pkgnum {
2466   my( $self, $pkgnum ) = @_;
2467   my $total_unapplied = 0;
2468   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2469   sprintf( "%.2f", $total_unapplied );
2470 }
2471
2472
2473 =item total_unapplied_refunds
2474
2475 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2476 customer.  See L<FS::cust_refund/unapplied>.
2477
2478 =cut
2479
2480 sub total_unapplied_refunds {
2481   my $self = shift;
2482   my $custnum = $self->custnum;
2483
2484   my $unapplied_sql = FS::cust_refund->unapplied_sql;
2485
2486   my $sql = "
2487     SELECT SUM($unapplied_sql) FROM cust_refund
2488       WHERE custnum = $custnum
2489   ";
2490
2491   sprintf( "%.2f", $self->scalar_sql($sql) );
2492
2493 }
2494
2495 =item balance
2496
2497 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2498 total_unapplied_credits minus total_unapplied_payments).
2499
2500 =cut
2501
2502 sub balance {
2503   my $self = shift;
2504   $self->balance_date_range;
2505 }
2506
2507 =item balance_date TIME
2508
2509 Returns the balance for this customer, only considering invoices with date
2510 earlier than TIME (total_owed_date minus total_credited minus
2511 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2512 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2513 functions.
2514
2515 =cut
2516
2517 sub balance_date {
2518   my $self = shift;
2519   $self->balance_date_range(shift);
2520 }
2521
2522 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2523
2524 Returns the balance for this customer, optionally considering invoices with
2525 date earlier than START_TIME, and not later than END_TIME
2526 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2527
2528 Times are specified as SQL fragments or numeric
2529 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
2530 L<Date::Parse> for conversion functions.  The empty string can be passed
2531 to disable that time constraint completely.
2532
2533 Available options are:
2534
2535 =over 4
2536
2537 =item unapplied_date
2538
2539 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)
2540
2541 =back
2542
2543 =cut
2544
2545 sub balance_date_range {
2546   my $self = shift;
2547   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2548             ') FROM cust_main WHERE custnum='. $self->custnum;
2549   sprintf( '%.2f', $self->scalar_sql($sql) );
2550 }
2551
2552 =item balance_pkgnum PKGNUM
2553
2554 Returns the balance for this customer's specific package when using
2555 experimental package balances (total_owed plus total_unrefunded, minus
2556 total_unapplied_credits minus total_unapplied_payments)
2557
2558 =cut
2559
2560 sub balance_pkgnum {
2561   my( $self, $pkgnum ) = @_;
2562
2563   sprintf( "%.2f",
2564       $self->total_owed_pkgnum($pkgnum)
2565 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2566 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
2567     - $self->total_unapplied_credits_pkgnum($pkgnum)
2568     - $self->total_unapplied_payments_pkgnum($pkgnum)
2569   );
2570 }
2571
2572 =item in_transit_payments
2573
2574 Returns the total of requests for payments for this customer pending in
2575 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
2576
2577 =cut
2578
2579 sub in_transit_payments {
2580   my $self = shift;
2581   my $in_transit_payments = 0;
2582   foreach my $pay_batch ( qsearch('pay_batch', {
2583     'status' => 'I',
2584   } ) ) {
2585     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2586       'batchnum' => $pay_batch->batchnum,
2587       'custnum' => $self->custnum,
2588     } ) ) {
2589       $in_transit_payments += $cust_pay_batch->amount;
2590     }
2591   }
2592   sprintf( "%.2f", $in_transit_payments );
2593 }
2594
2595 =item payment_info
2596
2597 Returns a hash of useful information for making a payment.
2598
2599 =over 4
2600
2601 =item balance
2602
2603 Current balance.
2604
2605 =item payby
2606
2607 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2608 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2609 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2610
2611 =back
2612
2613 For credit card transactions:
2614
2615 =over 4
2616
2617 =item card_type 1
2618
2619 =item payname
2620
2621 Exact name on card
2622
2623 =back
2624
2625 For electronic check transactions:
2626
2627 =over 4
2628
2629 =item stateid_state
2630
2631 =back
2632
2633 =cut
2634
2635 sub payment_info {
2636   my $self = shift;
2637
2638   my %return = ();
2639
2640   $return{balance} = $self->balance;
2641
2642   $return{payname} = $self->payname
2643                      || ( $self->first. ' '. $self->get('last') );
2644
2645   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
2646
2647   $return{payby} = $self->payby;
2648   $return{stateid_state} = $self->stateid_state;
2649
2650   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2651     $return{card_type} = cardtype($self->payinfo);
2652     $return{payinfo} = $self->paymask;
2653
2654     @return{'month', 'year'} = $self->paydate_monthyear;
2655
2656   }
2657
2658   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2659     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2660     $return{payinfo1} = $payinfo1;
2661     $return{payinfo2} = $payinfo2;
2662     $return{paytype}  = $self->paytype;
2663     $return{paystate} = $self->paystate;
2664
2665   }
2666
2667   #doubleclick protection
2668   my $_date = time;
2669   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2670
2671   %return;
2672
2673 }
2674
2675 =item paydate_monthyear
2676
2677 Returns a two-element list consisting of the month and year of this customer's
2678 paydate (credit card expiration date for CARD customers)
2679
2680 =cut
2681
2682 sub paydate_monthyear {
2683   my $self = shift;
2684   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2685     ( $2, $1 );
2686   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2687     ( $1, $3 );
2688   } else {
2689     ('', '');
2690   }
2691 }
2692
2693 =item tax_exemption TAXNAME
2694
2695 =cut
2696
2697 sub tax_exemption {
2698   my( $self, $taxname ) = @_;
2699
2700   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
2701                                      'taxname' => $taxname,
2702                                    },
2703           );
2704 }
2705
2706 =item cust_main_exemption
2707
2708 =cut
2709
2710 sub cust_main_exemption {
2711   my $self = shift;
2712   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
2713 }
2714
2715 =item invoicing_list [ ARRAYREF ]
2716
2717 If an arguement is given, sets these email addresses as invoice recipients
2718 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
2719 (except as warnings), so use check_invoicing_list first.
2720
2721 Returns a list of email addresses (with svcnum entries expanded).
2722
2723 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
2724 check it without disturbing anything by passing nothing.
2725
2726 This interface may change in the future.
2727
2728 =cut
2729
2730 sub invoicing_list {
2731   my( $self, $arrayref ) = @_;
2732
2733   if ( $arrayref ) {
2734     my @cust_main_invoice;
2735     if ( $self->custnum ) {
2736       @cust_main_invoice =
2737         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2738     } else {
2739       @cust_main_invoice = ();
2740     }
2741     foreach my $cust_main_invoice ( @cust_main_invoice ) {
2742       #warn $cust_main_invoice->destnum;
2743       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
2744         #warn $cust_main_invoice->destnum;
2745         my $error = $cust_main_invoice->delete;
2746         warn $error if $error;
2747       }
2748     }
2749     if ( $self->custnum ) {
2750       @cust_main_invoice =
2751         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2752     } else {
2753       @cust_main_invoice = ();
2754     }
2755     my %seen = map { $_->address => 1 } @cust_main_invoice;
2756     foreach my $address ( @{$arrayref} ) {
2757       next if exists $seen{$address} && $seen{$address};
2758       $seen{$address} = 1;
2759       my $cust_main_invoice = new FS::cust_main_invoice ( {
2760         'custnum' => $self->custnum,
2761         'dest'    => $address,
2762       } );
2763       my $error = $cust_main_invoice->insert;
2764       warn $error if $error;
2765     }
2766   }
2767
2768   if ( $self->custnum ) {
2769     map { $_->address }
2770       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
2771   } else {
2772     ();
2773   }
2774
2775 }
2776
2777 =item check_invoicing_list ARRAYREF
2778
2779 Checks these arguements as valid input for the invoicing_list method.  If there
2780 is an error, returns the error, otherwise returns false.
2781
2782 =cut
2783
2784 sub check_invoicing_list {
2785   my( $self, $arrayref ) = @_;
2786
2787   foreach my $address ( @$arrayref ) {
2788
2789     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
2790       return 'Can\'t add FAX invoice destination with a blank FAX number.';
2791     }
2792
2793     my $cust_main_invoice = new FS::cust_main_invoice ( {
2794       'custnum' => $self->custnum,
2795       'dest'    => $address,
2796     } );
2797     my $error = $self->custnum
2798                 ? $cust_main_invoice->check
2799                 : $cust_main_invoice->checkdest
2800     ;
2801     return $error if $error;
2802
2803   }
2804
2805   return "Email address required"
2806     if $conf->exists('cust_main-require_invoicing_list_email')
2807     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
2808
2809   '';
2810 }
2811
2812 =item set_default_invoicing_list
2813
2814 Sets the invoicing list to all accounts associated with this customer,
2815 overwriting any previous invoicing list.
2816
2817 =cut
2818
2819 sub set_default_invoicing_list {
2820   my $self = shift;
2821   $self->invoicing_list($self->all_emails);
2822 }
2823
2824 =item all_emails
2825
2826 Returns the email addresses of all accounts provisioned for this customer.
2827
2828 =cut
2829
2830 sub all_emails {
2831   my $self = shift;
2832   my %list;
2833   foreach my $cust_pkg ( $self->all_pkgs ) {
2834     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
2835     my @svc_acct =
2836       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2837         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
2838           @cust_svc;
2839     $list{$_}=1 foreach map { $_->email } @svc_acct;
2840   }
2841   keys %list;
2842 }
2843
2844 =item invoicing_list_addpost
2845
2846 Adds postal invoicing to this customer.  If this customer is already configured
2847 to receive postal invoices, does nothing.
2848
2849 =cut
2850
2851 sub invoicing_list_addpost {
2852   my $self = shift;
2853   return if grep { $_ eq 'POST' } $self->invoicing_list;
2854   my @invoicing_list = $self->invoicing_list;
2855   push @invoicing_list, 'POST';
2856   $self->invoicing_list(\@invoicing_list);
2857 }
2858
2859 =item invoicing_list_emailonly
2860
2861 Returns the list of email invoice recipients (invoicing_list without non-email
2862 destinations such as POST and FAX).
2863
2864 =cut
2865
2866 sub invoicing_list_emailonly {
2867   my $self = shift;
2868   warn "$me invoicing_list_emailonly called"
2869     if $DEBUG;
2870   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
2871 }
2872
2873 =item invoicing_list_emailonly_scalar
2874
2875 Returns the list of email invoice recipients (invoicing_list without non-email
2876 destinations such as POST and FAX) as a comma-separated scalar.
2877
2878 =cut
2879
2880 sub invoicing_list_emailonly_scalar {
2881   my $self = shift;
2882   warn "$me invoicing_list_emailonly_scalar called"
2883     if $DEBUG;
2884   join(', ', $self->invoicing_list_emailonly);
2885 }
2886
2887 =item referral_custnum_cust_main
2888
2889 Returns the customer who referred this customer (or the empty string, if
2890 this customer was not referred).
2891
2892 Note the difference with referral_cust_main method: This method,
2893 referral_custnum_cust_main returns the single customer (if any) who referred
2894 this customer, while referral_cust_main returns an array of customers referred
2895 BY this customer.
2896
2897 =cut
2898
2899 sub referral_custnum_cust_main {
2900   my $self = shift;
2901   return '' unless $self->referral_custnum;
2902   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2903 }
2904
2905 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
2906
2907 Returns an array of customers referred by this customer (referral_custnum set
2908 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
2909 customers referred by customers referred by this customer and so on, inclusive.
2910 The default behavior is DEPTH 1 (no recursion).
2911
2912 Note the difference with referral_custnum_cust_main method: This method,
2913 referral_cust_main, returns an array of customers referred BY this customer,
2914 while referral_custnum_cust_main returns the single customer (if any) who
2915 referred this customer.
2916
2917 =cut
2918
2919 sub referral_cust_main {
2920   my $self = shift;
2921   my $depth = @_ ? shift : 1;
2922   my $exclude = @_ ? shift : {};
2923
2924   my @cust_main =
2925     map { $exclude->{$_->custnum}++; $_; }
2926       grep { ! $exclude->{ $_->custnum } }
2927         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
2928
2929   if ( $depth > 1 ) {
2930     push @cust_main,
2931       map { $_->referral_cust_main($depth-1, $exclude) }
2932         @cust_main;
2933   }
2934
2935   @cust_main;
2936 }
2937
2938 =item referral_cust_main_ncancelled
2939
2940 Same as referral_cust_main, except only returns customers with uncancelled
2941 packages.
2942
2943 =cut
2944
2945 sub referral_cust_main_ncancelled {
2946   my $self = shift;
2947   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
2948 }
2949
2950 =item referral_cust_pkg [ DEPTH ]
2951
2952 Like referral_cust_main, except returns a flat list of all unsuspended (and
2953 uncancelled) packages for each customer.  The number of items in this list may
2954 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
2955
2956 =cut
2957
2958 sub referral_cust_pkg {
2959   my $self = shift;
2960   my $depth = @_ ? shift : 1;
2961
2962   map { $_->unsuspended_pkgs }
2963     grep { $_->unsuspended_pkgs }
2964       $self->referral_cust_main($depth);
2965 }
2966
2967 =item referring_cust_main
2968
2969 Returns the single cust_main record for the customer who referred this customer
2970 (referral_custnum), or false.
2971
2972 =cut
2973
2974 sub referring_cust_main {
2975   my $self = shift;
2976   return '' unless $self->referral_custnum;
2977   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
2978 }
2979
2980 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
2981
2982 Applies a credit to this customer.  If there is an error, returns the error,
2983 otherwise returns false.
2984
2985 REASON can be a text string, an FS::reason object, or a scalar reference to
2986 a reasonnum.  If a text string, it will be automatically inserted as a new
2987 reason, and a 'reason_type' option must be passed to indicate the
2988 FS::reason_type for the new reason.
2989
2990 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
2991
2992 Any other options are passed to FS::cust_credit::insert.
2993
2994 =cut
2995
2996 sub credit {
2997   my( $self, $amount, $reason, %options ) = @_;
2998
2999   my $cust_credit = new FS::cust_credit {
3000     'custnum' => $self->custnum,
3001     'amount'  => $amount,
3002   };
3003
3004   if ( ref($reason) ) {
3005
3006     if ( ref($reason) eq 'SCALAR' ) {
3007       $cust_credit->reasonnum( $$reason );
3008     } else {
3009       $cust_credit->reasonnum( $reason->reasonnum );
3010     }
3011
3012   } else {
3013     $cust_credit->set('reason', $reason)
3014   }
3015
3016   for (qw( addlinfo eventnum )) {
3017     $cust_credit->$_( delete $options{$_} )
3018       if exists($options{$_});
3019   }
3020
3021   $cust_credit->insert(%options);
3022
3023 }
3024
3025 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3026
3027 Creates a one-time charge for this customer.  If there is an error, returns
3028 the error, otherwise returns false.
3029
3030 New-style, with a hashref of options:
3031
3032   my $error = $cust_main->charge(
3033                                   {
3034                                     'amount'     => 54.32,
3035                                     'quantity'   => 1,
3036                                     'start_date' => str2time('7/4/2009'),
3037                                     'pkg'        => 'Description',
3038                                     'comment'    => 'Comment',
3039                                     'additional' => [], #extra invoice detail
3040                                     'classnum'   => 1,  #pkg_class
3041
3042                                     'setuptax'   => '', # or 'Y' for tax exempt
3043
3044                                     #internal taxation
3045                                     'taxclass'   => 'Tax class',
3046
3047                                     #vendor taxation
3048                                     'taxproduct' => 2,  #part_pkg_taxproduct
3049                                     'override'   => {}, #XXX describe
3050
3051                                     #will be filled in with the new object
3052                                     'cust_pkg_ref' => \$cust_pkg,
3053
3054                                     #generate an invoice immediately
3055                                     'bill_now' => 0,
3056                                     'invoice_terms' => '', #with these terms
3057                                   }
3058                                 );
3059
3060 Old-style:
3061
3062   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3063
3064 =cut
3065
3066 sub charge {
3067   my $self = shift;
3068   my ( $amount, $quantity, $start_date, $classnum );
3069   my ( $pkg, $comment, $additional );
3070   my ( $setuptax, $taxclass );   #internal taxes
3071   my ( $taxproduct, $override ); #vendor (CCH) taxes
3072   my $no_auto = '';
3073   my $cust_pkg_ref = '';
3074   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3075   if ( ref( $_[0] ) ) {
3076     $amount     = $_[0]->{amount};
3077     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3078     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3079     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3080     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3081     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3082                                            : '$'. sprintf("%.2f",$amount);
3083     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3084     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3085     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3086     $additional = $_[0]->{additional} || [];
3087     $taxproduct = $_[0]->{taxproductnum};
3088     $override   = { '' => $_[0]->{tax_override} };
3089     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3090     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3091     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3092   } else {
3093     $amount     = shift;
3094     $quantity   = 1;
3095     $start_date = '';
3096     $pkg        = @_ ? shift : 'One-time charge';
3097     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3098     $setuptax   = '';
3099     $taxclass   = @_ ? shift : '';
3100     $additional = [];
3101   }
3102
3103   local $SIG{HUP} = 'IGNORE';
3104   local $SIG{INT} = 'IGNORE';
3105   local $SIG{QUIT} = 'IGNORE';
3106   local $SIG{TERM} = 'IGNORE';
3107   local $SIG{TSTP} = 'IGNORE';
3108   local $SIG{PIPE} = 'IGNORE';
3109
3110   my $oldAutoCommit = $FS::UID::AutoCommit;
3111   local $FS::UID::AutoCommit = 0;
3112   my $dbh = dbh;
3113
3114   my $part_pkg = new FS::part_pkg ( {
3115     'pkg'           => $pkg,
3116     'comment'       => $comment,
3117     'plan'          => 'flat',
3118     'freq'          => 0,
3119     'disabled'      => 'Y',
3120     'classnum'      => ( $classnum ? $classnum : '' ),
3121     'setuptax'      => $setuptax,
3122     'taxclass'      => $taxclass,
3123     'taxproductnum' => $taxproduct,
3124   } );
3125
3126   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3127                         ( 0 .. @$additional - 1 )
3128                   ),
3129                   'additional_count' => scalar(@$additional),
3130                   'setup_fee' => $amount,
3131                 );
3132
3133   my $error = $part_pkg->insert( options       => \%options,
3134                                  tax_overrides => $override,
3135                                );
3136   if ( $error ) {
3137     $dbh->rollback if $oldAutoCommit;
3138     return $error;
3139   }
3140
3141   my $pkgpart = $part_pkg->pkgpart;
3142   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3143   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3144     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3145     $error = $type_pkgs->insert;
3146     if ( $error ) {
3147       $dbh->rollback if $oldAutoCommit;
3148       return $error;
3149     }
3150   }
3151
3152   my $cust_pkg = new FS::cust_pkg ( {
3153     'custnum'    => $self->custnum,
3154     'pkgpart'    => $pkgpart,
3155     'quantity'   => $quantity,
3156     'start_date' => $start_date,
3157     'no_auto'    => $no_auto,
3158   } );
3159
3160   $error = $cust_pkg->insert;
3161   if ( $error ) {
3162     $dbh->rollback if $oldAutoCommit;
3163     return $error;
3164   } elsif ( $cust_pkg_ref ) {
3165     ${$cust_pkg_ref} = $cust_pkg;
3166   }
3167
3168   if ( $bill_now ) {
3169     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3170                              'pkg_list'      => [ $cust_pkg ],
3171                            );
3172     if ( $error ) {
3173       $dbh->rollback if $oldAutoCommit;
3174       return $error;
3175     }
3176   }
3177
3178   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3179   return '';
3180
3181 }
3182
3183 #=item charge_postal_fee
3184 #
3185 #Applies a one time charge this customer.  If there is an error,
3186 #returns the error, returns the cust_pkg charge object or false
3187 #if there was no charge.
3188 #
3189 #=cut
3190 #
3191 # This should be a customer event.  For that to work requires that bill
3192 # also be a customer event.
3193
3194 sub charge_postal_fee {
3195   my $self = shift;
3196
3197   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
3198   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3199
3200   my $cust_pkg = new FS::cust_pkg ( {
3201     'custnum'  => $self->custnum,
3202     'pkgpart'  => $pkgpart,
3203     'quantity' => 1,
3204   } );
3205
3206   my $error = $cust_pkg->insert;
3207   $error ? $error : $cust_pkg;
3208 }
3209
3210 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3211
3212 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3213
3214 Optionally, a list or hashref of additional arguments to the qsearch call can
3215 be passed.
3216
3217 =cut
3218
3219 sub cust_bill {
3220   my $self = shift;
3221   my $opt = ref($_[0]) ? shift : { @_ };
3222
3223   #return $self->num_cust_bill unless wantarray || keys %$opt;
3224
3225   $opt->{'table'} = 'cust_bill';
3226   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3227   $opt->{'hashref'}{'custnum'} = $self->custnum;
3228   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3229
3230   map { $_ } #behavior of sort undefined in scalar context
3231     sort { $a->_date <=> $b->_date }
3232       qsearch($opt);
3233 }
3234
3235 =item open_cust_bill
3236
3237 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3238 customer.
3239
3240 =cut
3241
3242 sub open_cust_bill {
3243   my $self = shift;
3244
3245   $self->cust_bill(
3246     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3247     #@_
3248   );
3249
3250 }
3251
3252 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3253
3254 Returns all the statements (see L<FS::cust_statement>) for this customer.
3255
3256 Optionally, a list or hashref of additional arguments to the qsearch call can
3257 be passed.
3258
3259 =cut
3260
3261 sub cust_statement {
3262   my $self = shift;
3263   my $opt = ref($_[0]) ? shift : { @_ };
3264
3265   #return $self->num_cust_statement unless wantarray || keys %$opt;
3266
3267   $opt->{'table'} = 'cust_statement';
3268   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3269   $opt->{'hashref'}{'custnum'} = $self->custnum;
3270   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3271
3272   map { $_ } #behavior of sort undefined in scalar context
3273     sort { $a->_date <=> $b->_date }
3274       qsearch($opt);
3275 }
3276
3277 =item cust_credit
3278
3279 Returns all the credits (see L<FS::cust_credit>) for this customer.
3280
3281 =cut
3282
3283 sub cust_credit {
3284   my $self = shift;
3285   map { $_ } #return $self->num_cust_credit unless wantarray;
3286   sort { $a->_date <=> $b->_date }
3287     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3288 }
3289
3290 =item cust_credit_pkgnum
3291
3292 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3293 package when using experimental package balances.
3294
3295 =cut
3296
3297 sub cust_credit_pkgnum {
3298   my( $self, $pkgnum ) = @_;
3299   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3300   sort { $a->_date <=> $b->_date }
3301     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3302                               'pkgnum'  => $pkgnum,
3303                             }
3304     );
3305 }
3306
3307 =item cust_pay
3308
3309 Returns all the payments (see L<FS::cust_pay>) for this customer.
3310
3311 =cut
3312
3313 sub cust_pay {
3314   my $self = shift;
3315   return $self->num_cust_pay unless wantarray;
3316   sort { $a->_date <=> $b->_date }
3317     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3318 }
3319
3320 =item num_cust_pay
3321
3322 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3323 called automatically when the cust_pay method is used in a scalar context.
3324
3325 =cut
3326
3327 sub num_cust_pay {
3328   my $self = shift;
3329   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3330   my $sth = dbh->prepare($sql) or die dbh->errstr;
3331   $sth->execute($self->custnum) or die $sth->errstr;
3332   $sth->fetchrow_arrayref->[0];
3333 }
3334
3335 =item cust_pay_pkgnum
3336
3337 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3338 package when using experimental package balances.
3339
3340 =cut
3341
3342 sub cust_pay_pkgnum {
3343   my( $self, $pkgnum ) = @_;
3344   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3345   sort { $a->_date <=> $b->_date }
3346     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3347                            'pkgnum'  => $pkgnum,
3348                          }
3349     );
3350 }
3351
3352 =item cust_pay_void
3353
3354 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3355
3356 =cut
3357
3358 sub cust_pay_void {
3359   my $self = shift;
3360   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3361   sort { $a->_date <=> $b->_date }
3362     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3363 }
3364
3365 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3366
3367 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
3368
3369 Optionally, a list or hashref of additional arguments to the qsearch call can
3370 be passed.
3371
3372 =cut
3373
3374 sub cust_pay_batch {
3375   my $self = shift;
3376   my $opt = ref($_[0]) ? shift : { @_ };
3377
3378   #return $self->num_cust_statement unless wantarray || keys %$opt;
3379
3380   $opt->{'table'} = 'cust_pay_batch';
3381   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3382   $opt->{'hashref'}{'custnum'} = $self->custnum;
3383   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3384
3385   map { $_ } #behavior of sort undefined in scalar context
3386     sort { $a->paybatchnum <=> $b->paybatchnum }
3387       qsearch($opt);
3388 }
3389
3390 =item cust_pay_pending
3391
3392 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3393 (without status "done").
3394
3395 =cut
3396
3397 sub cust_pay_pending {
3398   my $self = shift;
3399   return $self->num_cust_pay_pending unless wantarray;
3400   sort { $a->_date <=> $b->_date }
3401     qsearch( 'cust_pay_pending', {
3402                                    'custnum' => $self->custnum,
3403                                    'status'  => { op=>'!=', value=>'done' },
3404                                  },
3405            );
3406 }
3407
3408 =item cust_pay_pending_attempt
3409
3410 Returns all payment attempts / declined payments for this customer, as pending
3411 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3412 a corresponding payment (see L<FS::cust_pay>).
3413
3414 =cut
3415
3416 sub cust_pay_pending_attempt {
3417   my $self = shift;
3418   return $self->num_cust_pay_pending_attempt unless wantarray;
3419   sort { $a->_date <=> $b->_date }
3420     qsearch( 'cust_pay_pending', {
3421                                    'custnum' => $self->custnum,
3422                                    'status'  => 'done',
3423                                    'paynum'  => '',
3424                                  },
3425            );
3426 }
3427
3428 =item num_cust_pay_pending
3429
3430 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3431 customer (without status "done").  Also called automatically when the
3432 cust_pay_pending method is used in a scalar context.
3433
3434 =cut
3435
3436 sub num_cust_pay_pending {
3437   my $self = shift;
3438   $self->scalar_sql(
3439     " SELECT COUNT(*) FROM cust_pay_pending ".
3440       " WHERE custnum = ? AND status != 'done' ",
3441     $self->custnum
3442   );
3443 }
3444
3445 =item num_cust_pay_pending_attempt
3446
3447 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3448 customer, with status "done" but without a corresp.  Also called automatically when the
3449 cust_pay_pending method is used in a scalar context.
3450
3451 =cut
3452
3453 sub num_cust_pay_pending_attempt {
3454   my $self = shift;
3455   $self->scalar_sql(
3456     " SELECT COUNT(*) FROM cust_pay_pending ".
3457       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3458     $self->custnum
3459   );
3460 }
3461
3462 =item cust_refund
3463
3464 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3465
3466 =cut
3467
3468 sub cust_refund {
3469   my $self = shift;
3470   map { $_ } #return $self->num_cust_refund unless wantarray;
3471   sort { $a->_date <=> $b->_date }
3472     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3473 }
3474
3475 =item display_custnum
3476
3477 Returns the displayed customer number for this customer: agent_custid if
3478 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3479
3480 =cut
3481
3482 sub display_custnum {
3483   my $self = shift;
3484   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3485     return $self->agent_custid;
3486   } else {
3487     return $self->custnum;
3488   }
3489 }
3490
3491 =item name
3492
3493 Returns a name string for this customer, either "Company (Last, First)" or
3494 "Last, First".
3495
3496 =cut
3497
3498 sub name {
3499   my $self = shift;
3500   my $name = $self->contact;
3501   $name = $self->company. " ($name)" if $self->company;
3502   $name;
3503 }
3504
3505 =item ship_name
3506
3507 Returns a name string for this (service/shipping) contact, either
3508 "Company (Last, First)" or "Last, First".
3509
3510 =cut
3511
3512 sub ship_name {
3513   my $self = shift;
3514   if ( $self->get('ship_last') ) {
3515     my $name = $self->ship_contact;
3516     $name = $self->ship_company. " ($name)" if $self->ship_company;
3517     $name;
3518   } else {
3519     $self->name;
3520   }
3521 }
3522
3523 =item name_short
3524
3525 Returns a name string for this customer, either "Company" or "First Last".
3526
3527 =cut
3528
3529 sub name_short {
3530   my $self = shift;
3531   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
3532 }
3533
3534 =item ship_name_short
3535
3536 Returns a name string for this (service/shipping) contact, either "Company"
3537 or "First Last".
3538
3539 =cut
3540
3541 sub ship_name_short {
3542   my $self = shift;
3543   if ( $self->get('ship_last') ) {
3544     $self->ship_company !~ /^\s*$/
3545       ? $self->ship_company
3546       : $self->ship_contact_firstlast;
3547   } else {
3548     $self->name_company_or_firstlast;
3549   }
3550 }
3551
3552 =item contact
3553
3554 Returns this customer's full (billing) contact name only, "Last, First"
3555
3556 =cut
3557
3558 sub contact {
3559   my $self = shift;
3560   $self->get('last'). ', '. $self->first;
3561 }
3562
3563 =item ship_contact
3564
3565 Returns this customer's full (shipping) contact name only, "Last, First"
3566
3567 =cut
3568
3569 sub ship_contact {
3570   my $self = shift;
3571   $self->get('ship_last')
3572     ? $self->get('ship_last'). ', '. $self->ship_first
3573     : $self->contact;
3574 }
3575
3576 =item contact_firstlast
3577
3578 Returns this customers full (billing) contact name only, "First Last".
3579
3580 =cut
3581
3582 sub contact_firstlast {
3583   my $self = shift;
3584   $self->first. ' '. $self->get('last');
3585 }
3586
3587 =item ship_contact_firstlast
3588
3589 Returns this customer's full (shipping) contact name only, "First Last".
3590
3591 =cut
3592
3593 sub ship_contact_firstlast {
3594   my $self = shift;
3595   $self->get('ship_last')
3596     ? $self->first. ' '. $self->get('ship_last')
3597     : $self->contact_firstlast;
3598 }
3599
3600 =item country_full
3601
3602 Returns this customer's full country name
3603
3604 =cut
3605
3606 sub country_full {
3607   my $self = shift;
3608   code2country($self->country);
3609 }
3610
3611 =item geocode DATA_VENDOR
3612
3613 Returns a value for the customer location as encoded by DATA_VENDOR.
3614 Currently this only makes sense for "CCH" as DATA_VENDOR.
3615
3616 =cut
3617
3618 sub geocode {
3619   my ($self, $data_vendor) = (shift, shift);  #always cch for now
3620
3621   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
3622   return $geocode if $geocode;
3623
3624   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
3625                ? 'ship_'
3626                : '';
3627
3628   my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
3629     if $self->country eq 'US';
3630
3631   $zip ||= '';
3632   $plus4 ||= '';
3633   #CCH specific location stuff
3634   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
3635
3636   my @cust_tax_location =
3637     qsearch( {
3638                'table'     => 'cust_tax_location',
3639                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
3640                'extra_sql' => $extra_sql,
3641                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
3642              }
3643            );
3644   $geocode = $cust_tax_location[0]->geocode
3645     if scalar(@cust_tax_location);
3646
3647   $geocode;
3648 }
3649
3650 =item cust_status
3651
3652 =item status
3653
3654 Returns a status string for this customer, currently:
3655
3656 =over 4
3657
3658 =item prospect - No packages have ever been ordered
3659
3660 =item ordered - Recurring packages all are new (not yet billed).
3661
3662 =item active - One or more recurring packages is active
3663
3664 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
3665
3666 =item suspended - All non-cancelled recurring packages are suspended
3667
3668 =item cancelled - All recurring packages are cancelled
3669
3670 =back
3671
3672 =cut
3673
3674 sub status { shift->cust_status(@_); }
3675
3676 sub cust_status {
3677   my $self = shift;
3678   # prospect ordered active inactive suspended cancelled
3679   for my $status ( FS::cust_main->statuses() ) {
3680     my $method = $status.'_sql';
3681     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
3682     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
3683     $sth->execute( ($self->custnum) x $numnum )
3684       or die "Error executing 'SELECT $sql': ". $sth->errstr;
3685     return $status if $sth->fetchrow_arrayref->[0];
3686   }
3687 }
3688
3689 =item ucfirst_cust_status
3690
3691 =item ucfirst_status
3692
3693 Returns the status with the first character capitalized.
3694
3695 =cut
3696
3697 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
3698
3699 sub ucfirst_cust_status {
3700   my $self = shift;
3701   ucfirst($self->cust_status);
3702 }
3703
3704 =item statuscolor
3705
3706 Returns a hex triplet color string for this customer's status.
3707
3708 =cut
3709
3710 use vars qw(%statuscolor);
3711 tie %statuscolor, 'Tie::IxHash',
3712   'prospect'  => '7e0079', #'000000', #black?  naw, purple
3713   'active'    => '00CC00', #green
3714   'ordered'   => '009999', #teal? cyan?
3715   'inactive'  => '0000CC', #blue
3716   'suspended' => 'FF9900', #yellow
3717   'cancelled' => 'FF0000', #red
3718 ;
3719
3720 sub statuscolor { shift->cust_statuscolor(@_); }
3721
3722 sub cust_statuscolor {
3723   my $self = shift;
3724   $statuscolor{$self->cust_status};
3725 }
3726
3727 =item tickets
3728
3729 Returns an array of hashes representing the customer's RT tickets.
3730
3731 =cut
3732
3733 sub tickets {
3734   my $self = shift;
3735
3736   my $num = $conf->config('cust_main-max_tickets') || 10;
3737   my @tickets = ();
3738
3739   if ( $conf->config('ticket_system') ) {
3740     unless ( $conf->config('ticket_system-custom_priority_field') ) {
3741
3742       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
3743
3744     } else {
3745
3746       foreach my $priority (
3747         $conf->config('ticket_system-custom_priority_field-values'), ''
3748       ) {
3749         last if scalar(@tickets) >= $num;
3750         push @tickets,
3751           @{ FS::TicketSystem->customer_tickets( $self->custnum,
3752                                                  $num - scalar(@tickets),
3753                                                  $priority,
3754                                                )
3755            };
3756       }
3757     }
3758   }
3759   (@tickets);
3760 }
3761
3762 # Return services representing svc_accts in customer support packages
3763 sub support_services {
3764   my $self = shift;
3765   my %packages = map { $_ => 1 } $conf->config('support_packages');
3766
3767   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
3768     grep { $_->part_svc->svcdb eq 'svc_acct' }
3769     map { $_->cust_svc }
3770     grep { exists $packages{ $_->pkgpart } }
3771     $self->ncancelled_pkgs;
3772
3773 }
3774
3775 # Return a list of latitude/longitude for one of the services (if any)
3776 sub service_coordinates {
3777   my $self = shift;
3778
3779   my @svc_X =
3780     grep { $_->latitude && $_->longitude }
3781     map { $_->svc_x }
3782     map { $_->cust_svc }
3783     $self->ncancelled_pkgs;
3784
3785   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
3786 }
3787
3788 =item masked FIELD
3789
3790 Returns a masked version of the named field
3791
3792 =cut
3793
3794 sub masked {
3795 my ($self,$field) = @_;
3796
3797 # Show last four
3798
3799 'x'x(length($self->getfield($field))-4).
3800   substr($self->getfield($field), (length($self->getfield($field))-4));
3801
3802 }
3803
3804 =back
3805
3806 =head1 CLASS METHODS
3807
3808 =over 4
3809
3810 =item statuses
3811
3812 Class method that returns the list of possible status strings for customers
3813 (see L<the status method|/status>).  For example:
3814
3815   @statuses = FS::cust_main->statuses();
3816
3817 =cut
3818
3819 sub statuses {
3820   #my $self = shift; #could be class...
3821   keys %statuscolor;
3822 }
3823
3824 =item prospect_sql
3825
3826 Returns an SQL expression identifying prospective cust_main records (customers
3827 with no packages ever ordered)
3828
3829 =cut
3830
3831 use vars qw($select_count_pkgs);
3832 $select_count_pkgs =
3833   "SELECT COUNT(*) FROM cust_pkg
3834     WHERE cust_pkg.custnum = cust_main.custnum";
3835
3836 sub select_count_pkgs_sql {
3837   $select_count_pkgs;
3838 }
3839
3840 sub prospect_sql {
3841   " 0 = ( $select_count_pkgs ) ";
3842 }
3843
3844 =item ordered_sql
3845
3846 Returns an SQL expression identifying ordered cust_main records (customers with
3847 recurring packages not yet setup).
3848
3849 =cut
3850
3851 sub ordered_sql {
3852   FS::cust_main->none_active_sql.
3853   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
3854 }
3855
3856 =item active_sql
3857
3858 Returns an SQL expression identifying active cust_main records (customers with
3859 active recurring packages).
3860
3861 =cut
3862
3863 sub active_sql {
3864   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
3865 }
3866
3867 =item none_active_sql
3868
3869 Returns an SQL expression identifying cust_main records with no active
3870 recurring packages.  This includes customers of status prospect, ordered,
3871 inactive, and suspended.
3872
3873 =cut
3874
3875 sub none_active_sql {
3876   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
3877 }
3878
3879 =item inactive_sql
3880
3881 Returns an SQL expression identifying inactive cust_main records (customers with
3882 no active recurring packages, but otherwise unsuspended/uncancelled).
3883
3884 =cut
3885
3886 sub inactive_sql {
3887   FS::cust_main->none_active_sql.
3888   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
3889 }
3890
3891 =item susp_sql
3892 =item suspended_sql
3893
3894 Returns an SQL expression identifying suspended cust_main records.
3895
3896 =cut
3897
3898
3899 sub suspended_sql { susp_sql(@_); }
3900 sub susp_sql {
3901   FS::cust_main->none_active_sql.
3902   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
3903 }
3904
3905 =item cancel_sql
3906 =item cancelled_sql
3907
3908 Returns an SQL expression identifying cancelled cust_main records.
3909
3910 =cut
3911
3912 sub cancelled_sql { cancel_sql(@_); }
3913 sub cancel_sql {
3914
3915   my $recurring_sql = FS::cust_pkg->recurring_sql;
3916   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
3917
3918   "
3919         0 < ( $select_count_pkgs )
3920     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
3921     AND 0 = ( $select_count_pkgs AND $recurring_sql
3922                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3923             )
3924     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
3925   ";
3926
3927 }
3928
3929 =item uncancel_sql
3930 =item uncancelled_sql
3931
3932 Returns an SQL expression identifying un-cancelled cust_main records.
3933
3934 =cut
3935
3936 sub uncancelled_sql { uncancel_sql(@_); }
3937 sub uncancel_sql { "
3938   ( 0 < ( $select_count_pkgs
3939                    AND ( cust_pkg.cancel IS NULL
3940                          OR cust_pkg.cancel = 0
3941                        )
3942         )
3943     OR 0 = ( $select_count_pkgs )
3944   )
3945 "; }
3946
3947 =item balance_sql
3948
3949 Returns an SQL fragment to retreive the balance.
3950
3951 =cut
3952
3953 sub balance_sql { "
3954     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
3955         WHERE cust_bill.custnum   = cust_main.custnum     )
3956   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
3957         WHERE cust_pay.custnum    = cust_main.custnum     )
3958   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
3959         WHERE cust_credit.custnum = cust_main.custnum     )
3960   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
3961         WHERE cust_refund.custnum = cust_main.custnum     )
3962 "; }
3963
3964 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
3965
3966 Returns an SQL fragment to retreive the balance for this customer, optionally
3967 considering invoices with date earlier than START_TIME, and not
3968 later than END_TIME (total_owed_date minus total_unapplied_credits minus
3969 total_unapplied_payments).
3970
3971 Times are specified as SQL fragments or numeric
3972 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
3973 L<Date::Parse> for conversion functions.  The empty string can be passed
3974 to disable that time constraint completely.
3975
3976 Available options are:
3977
3978 =over 4
3979
3980 =item unapplied_date
3981
3982 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)
3983
3984 =item total
3985
3986 (unused.  obsolete?)
3987 set to true to remove all customer comparison clauses, for totals
3988
3989 =item where
3990
3991 (unused.  obsolete?)
3992 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
3993
3994 =item join
3995
3996 (unused.  obsolete?)
3997 JOIN clause (typically used with the total option)
3998
3999 =item cutoff
4000
4001 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4002 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4003 range for invoices and I<unapplied> payments, credits, and refunds.
4004
4005 =back
4006
4007 =cut
4008
4009 sub balance_date_sql {
4010   my( $class, $start, $end, %opt ) = @_;
4011
4012   my $cutoff = $opt{'cutoff'};
4013
4014   my $owed         = FS::cust_bill->owed_sql($cutoff);
4015   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4016   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4017   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4018
4019   my $j = $opt{'join'} || '';
4020
4021   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4022   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4023   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4024   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4025
4026   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4027     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4028     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4029     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4030   ";
4031
4032 }
4033
4034 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4035
4036 Returns an SQL fragment to retreive the total unapplied payments for this
4037 customer, only considering invoices with date earlier than START_TIME, and
4038 optionally not later than END_TIME.
4039
4040 Times are specified as SQL fragments or numeric
4041 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4042 L<Date::Parse> for conversion functions.  The empty string can be passed
4043 to disable that time constraint completely.
4044
4045 Available options are:
4046
4047 =cut
4048
4049 sub unapplied_payments_date_sql {
4050   my( $class, $start, $end, %opt ) = @_;
4051
4052   my $cutoff = $opt{'cutoff'};
4053
4054   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4055
4056   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4057                                                           'unapplied_date'=>1 );
4058
4059   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4060 }
4061
4062 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4063
4064 Helper method for balance_date_sql; name (and usage) subject to change
4065 (suggestions welcome).
4066
4067 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4068 cust_refund, cust_credit or cust_pay).
4069
4070 If TABLE is "cust_bill" or the unapplied_date option is true, only
4071 considers records with date earlier than START_TIME, and optionally not
4072 later than END_TIME .
4073
4074 =cut
4075
4076 sub _money_table_where {
4077   my( $class, $table, $start, $end, %opt ) = @_;
4078
4079   my @where = ();
4080   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4081   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4082     push @where, "$table._date <= $start" if defined($start) && length($start);
4083     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4084   }
4085   push @where, @{$opt{'where'}} if $opt{'where'};
4086   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4087
4088   $where;
4089
4090 }
4091
4092 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4093 use FS::cust_main::Search;
4094 sub search {
4095   my $class = shift;
4096   FS::cust_main::Search->search(@_);
4097 }
4098
4099 =back
4100
4101 =head1 SUBROUTINES
4102
4103 =over 4
4104
4105 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
4106
4107 =cut
4108
4109 use FS::cust_main::Search;
4110 sub append_fuzzyfiles {
4111   #my( $first, $last, $company ) = @_;
4112
4113   FS::cust_main::Search::check_and_rebuild_fuzzyfiles();
4114
4115   use Fcntl qw(:flock);
4116
4117   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
4118
4119   foreach my $field (@fuzzyfields) {
4120     my $value = shift;
4121
4122     if ( $value ) {
4123
4124       open(CACHE,">>$dir/cust_main.$field")
4125         or die "can't open $dir/cust_main.$field: $!";
4126       flock(CACHE,LOCK_EX)
4127         or die "can't lock $dir/cust_main.$field: $!";
4128
4129       print CACHE "$value\n";
4130
4131       flock(CACHE,LOCK_UN)
4132         or die "can't unlock $dir/cust_main.$field: $!";
4133       close CACHE;
4134     }
4135
4136   }
4137
4138   1;
4139 }
4140
4141 =item batch_charge
4142
4143 =cut
4144
4145 sub batch_charge {
4146   my $param = shift;
4147   #warn join('-',keys %$param);
4148   my $fh = $param->{filehandle};
4149   my $agentnum = $param->{agentnum};
4150   my $format = $param->{format};
4151
4152   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4153
4154   my @fields;
4155   if ( $format eq 'simple' ) {
4156     @fields = qw( custnum agent_custid amount pkg );
4157   } else {
4158     die "unknown format $format";
4159   }
4160
4161   eval "use Text::CSV_XS;";
4162   die $@ if $@;
4163
4164   my $csv = new Text::CSV_XS;
4165   #warn $csv;
4166   #warn $fh;
4167
4168   my $imported = 0;
4169   #my $columns;
4170
4171   local $SIG{HUP} = 'IGNORE';
4172   local $SIG{INT} = 'IGNORE';
4173   local $SIG{QUIT} = 'IGNORE';
4174   local $SIG{TERM} = 'IGNORE';
4175   local $SIG{TSTP} = 'IGNORE';
4176   local $SIG{PIPE} = 'IGNORE';
4177
4178   my $oldAutoCommit = $FS::UID::AutoCommit;
4179   local $FS::UID::AutoCommit = 0;
4180   my $dbh = dbh;
4181
4182   #while ( $columns = $csv->getline($fh) ) {
4183   my $line;
4184   while ( defined($line=<$fh>) ) {
4185
4186     $csv->parse($line) or do {
4187       $dbh->rollback if $oldAutoCommit;
4188       return "can't parse: ". $csv->error_input();
4189     };
4190
4191     my @columns = $csv->fields();
4192     #warn join('-',@columns);
4193
4194     my %row = ();
4195     foreach my $field ( @fields ) {
4196       $row{$field} = shift @columns;
4197     }
4198
4199     if ( $row{custnum} && $row{agent_custid} ) {
4200       dbh->rollback if $oldAutoCommit;
4201       return "can't specify custnum with agent_custid $row{agent_custid}";
4202     }
4203
4204     my %hash = ();
4205     if ( $row{agent_custid} && $agentnum ) {
4206       %hash = ( 'agent_custid' => $row{agent_custid},
4207                 'agentnum'     => $agentnum,
4208               );
4209     }
4210
4211     if ( $row{custnum} ) {
4212       %hash = ( 'custnum' => $row{custnum} );
4213     }
4214
4215     unless ( scalar(keys %hash) ) {
4216       $dbh->rollback if $oldAutoCommit;
4217       return "can't find customer without custnum or agent_custid and agentnum";
4218     }
4219
4220     my $cust_main = qsearchs('cust_main', { %hash } );
4221     unless ( $cust_main ) {
4222       $dbh->rollback if $oldAutoCommit;
4223       my $custnum = $row{custnum} || $row{agent_custid};
4224       return "unknown custnum $custnum";
4225     }
4226
4227     if ( $row{'amount'} > 0 ) {
4228       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4229       if ( $error ) {
4230         $dbh->rollback if $oldAutoCommit;
4231         return $error;
4232       }
4233       $imported++;
4234     } elsif ( $row{'amount'} < 0 ) {
4235       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4236                                       $row{'pkg'}                         );
4237       if ( $error ) {
4238         $dbh->rollback if $oldAutoCommit;
4239         return $error;
4240       }
4241       $imported++;
4242     } else {
4243       #hmm?
4244     }
4245
4246   }
4247
4248   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4249
4250   return "Empty file!" unless $imported;
4251
4252   ''; #no error
4253
4254 }
4255
4256 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4257
4258 Deprecated.  Use event notification and message templates
4259 (L<FS::msg_template>) instead.
4260
4261 Sends a templated email notification to the customer (see L<Text::Template>).
4262
4263 OPTIONS is a hash and may include
4264
4265 I<from> - the email sender (default is invoice_from)
4266
4267 I<to> - comma-separated scalar or arrayref of recipients
4268    (default is invoicing_list)
4269
4270 I<subject> - The subject line of the sent email notification
4271    (default is "Notice from company_name")
4272
4273 I<extra_fields> - a hashref of name/value pairs which will be substituted
4274    into the template
4275
4276 The following variables are vavailable in the template.
4277
4278 I<$first> - the customer first name
4279 I<$last> - the customer last name
4280 I<$company> - the customer company
4281 I<$payby> - a description of the method of payment for the customer
4282             # would be nice to use FS::payby::shortname
4283 I<$payinfo> - the account information used to collect for this customer
4284 I<$expdate> - the expiration of the customer payment in seconds from epoch
4285
4286 =cut
4287
4288 sub notify {
4289   my ($self, $template, %options) = @_;
4290
4291   return unless $conf->exists($template);
4292
4293   my $from = $conf->config('invoice_from', $self->agentnum)
4294     if $conf->exists('invoice_from', $self->agentnum);
4295   $from = $options{from} if exists($options{from});
4296
4297   my $to = join(',', $self->invoicing_list_emailonly);
4298   $to = $options{to} if exists($options{to});
4299
4300   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4301     if $conf->exists('company_name', $self->agentnum);
4302   $subject = $options{subject} if exists($options{subject});
4303
4304   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4305                                             SOURCE => [ map "$_\n",
4306                                               $conf->config($template)]
4307                                            )
4308     or die "can't create new Text::Template object: Text::Template::ERROR";
4309   $notify_template->compile()
4310     or die "can't compile template: Text::Template::ERROR";
4311
4312   $FS::notify_template::_template::company_name =
4313     $conf->config('company_name', $self->agentnum);
4314   $FS::notify_template::_template::company_address =
4315     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4316
4317   my $paydate = $self->paydate || '2037-12-31';
4318   $FS::notify_template::_template::first = $self->first;
4319   $FS::notify_template::_template::last = $self->last;
4320   $FS::notify_template::_template::company = $self->company;
4321   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4322   my $payby = $self->payby;
4323   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4324   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4325
4326   #credit cards expire at the end of the month/year of their exp date
4327   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4328     $FS::notify_template::_template::payby = 'credit card';
4329     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4330     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4331     $expire_time--;
4332   }elsif ($payby eq 'COMP') {
4333     $FS::notify_template::_template::payby = 'complimentary account';
4334   }else{
4335     $FS::notify_template::_template::payby = 'current method';
4336   }
4337   $FS::notify_template::_template::expdate = $expire_time;
4338
4339   for (keys %{$options{extra_fields}}){
4340     no strict "refs";
4341     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4342   }
4343
4344   send_email(from => $from,
4345              to => $to,
4346              subject => $subject,
4347              body => $notify_template->fill_in( PACKAGE =>
4348                                                 'FS::notify_template::_template'                                              ),
4349             );
4350
4351 }
4352
4353 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4354
4355 Generates a templated notification to the customer (see L<Text::Template>).
4356
4357 OPTIONS is a hash and may include
4358
4359 I<extra_fields> - a hashref of name/value pairs which will be substituted
4360    into the template.  These values may override values mentioned below
4361    and those from the customer record.
4362
4363 The following variables are available in the template instead of or in addition
4364 to the fields of the customer record.
4365
4366 I<$payby> - a description of the method of payment for the customer
4367             # would be nice to use FS::payby::shortname
4368 I<$payinfo> - the masked account information used to collect for this customer
4369 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4370 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4371
4372 =cut
4373
4374 # a lot like cust_bill::print_latex
4375 sub generate_letter {
4376   my ($self, $template, %options) = @_;
4377
4378   return unless $conf->exists($template);
4379
4380   my $letter_template = new Text::Template
4381                         ( TYPE       => 'ARRAY',
4382                           SOURCE     => [ map "$_\n", $conf->config($template)],
4383                           DELIMITERS => [ '[@--', '--@]' ],
4384                         )
4385     or die "can't create new Text::Template object: Text::Template::ERROR";
4386
4387   $letter_template->compile()
4388     or die "can't compile template: Text::Template::ERROR";
4389
4390   my %letter_data = map { $_ => $self->$_ } $self->fields;
4391   $letter_data{payinfo} = $self->mask_payinfo;
4392
4393   #my $paydate = $self->paydate || '2037-12-31';
4394   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4395
4396   my $payby = $self->payby;
4397   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4398   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4399
4400   #credit cards expire at the end of the month/year of their exp date
4401   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4402     $letter_data{payby} = 'credit card';
4403     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4404     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4405     $expire_time--;
4406   }elsif ($payby eq 'COMP') {
4407     $letter_data{payby} = 'complimentary account';
4408   }else{
4409     $letter_data{payby} = 'current method';
4410   }
4411   $letter_data{expdate} = $expire_time;
4412
4413   for (keys %{$options{extra_fields}}){
4414     $letter_data{$_} = $options{extra_fields}->{$_};
4415   }
4416
4417   unless(exists($letter_data{returnaddress})){
4418     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4419                                                   $self->agent_template)
4420                      );
4421     if ( length($retadd) ) {
4422       $letter_data{returnaddress} = $retadd;
4423     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4424       $letter_data{returnaddress} =
4425         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4426                           s/$/\\\\\*/;
4427                           $_;
4428                         }
4429                     ( $conf->config('company_name', $self->agentnum),
4430                       $conf->config('company_address', $self->agentnum),
4431                     )
4432         );
4433     } else {
4434       $letter_data{returnaddress} = '~';
4435     }
4436   }
4437
4438   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4439
4440   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4441
4442   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4443
4444   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4445                            DIR      => $dir,
4446                            SUFFIX   => '.eps',
4447                            UNLINK   => 0,
4448                          ) or die "can't open temp file: $!\n";
4449   print $lh $conf->config_binary('logo.eps', $self->agentnum)
4450     or die "can't write temp file: $!\n";
4451   close $lh;
4452   $letter_data{'logo_file'} = $lh->filename;
4453
4454   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4455                            DIR      => $dir,
4456                            SUFFIX   => '.tex',
4457                            UNLINK   => 0,
4458                          ) or die "can't open temp file: $!\n";
4459
4460   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4461   close $fh;
4462   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4463   return ($1, $letter_data{'logo_file'});
4464
4465 }
4466
4467 =item print_ps TEMPLATE
4468
4469 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4470
4471 =cut
4472
4473 sub print_ps {
4474   my $self = shift;
4475   my($file, $lfile) = $self->generate_letter(@_);
4476   my $ps = FS::Misc::generate_ps($file);
4477   unlink($file.'.tex');
4478   unlink($lfile);
4479
4480   $ps;
4481 }
4482
4483 =item print TEMPLATE
4484
4485 Prints the filled in template.
4486
4487 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4488
4489 =cut
4490
4491 sub queueable_print {
4492   my %opt = @_;
4493
4494   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4495     or die "invalid customer number: " . $opt{custvnum};
4496
4497   my $error = $self->print( $opt{template} );
4498   die $error if $error;
4499 }
4500
4501 sub print {
4502   my ($self, $template) = (shift, shift);
4503   do_print [ $self->print_ps($template) ];
4504 }
4505
4506 #these three subs should just go away once agent stuff is all config overrides
4507
4508 sub agent_template {
4509   my $self = shift;
4510   $self->_agent_plandata('agent_templatename');
4511 }
4512
4513 sub agent_invoice_from {
4514   my $self = shift;
4515   $self->_agent_plandata('agent_invoice_from');
4516 }
4517
4518 sub _agent_plandata {
4519   my( $self, $option ) = @_;
4520
4521   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
4522   #agent-specific Conf
4523
4524   use FS::part_event::Condition;
4525
4526   my $agentnum = $self->agentnum;
4527
4528   my $regexp = regexp_sql();
4529
4530   my $part_event_option =
4531     qsearchs({
4532       'select'    => 'part_event_option.*',
4533       'table'     => 'part_event_option',
4534       'addl_from' => q{
4535         LEFT JOIN part_event USING ( eventpart )
4536         LEFT JOIN part_event_option AS peo_agentnum
4537           ON ( part_event.eventpart = peo_agentnum.eventpart
4538                AND peo_agentnum.optionname = 'agentnum'
4539                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4540              )
4541         LEFT JOIN part_event_condition
4542           ON ( part_event.eventpart = part_event_condition.eventpart
4543                AND part_event_condition.conditionname = 'cust_bill_age'
4544              )
4545         LEFT JOIN part_event_condition_option
4546           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4547                AND part_event_condition_option.optionname = 'age'
4548              )
4549       },
4550       #'hashref'   => { 'optionname' => $option },
4551       #'hashref'   => { 'part_event_option.optionname' => $option },
4552       'extra_sql' =>
4553         " WHERE part_event_option.optionname = ". dbh->quote($option).
4554         " AND action = 'cust_bill_send_agent' ".
4555         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4556         " AND peo_agentnum.optionname = 'agentnum' ".
4557         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4558         " ORDER BY
4559            CASE WHEN part_event_condition_option.optionname IS NULL
4560            THEN -1
4561            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4562         " END
4563           , part_event.weight".
4564         " LIMIT 1"
4565     });
4566
4567   unless ( $part_event_option ) {
4568     return $self->agent->invoice_template || ''
4569       if $option eq 'agent_templatename';
4570     return '';
4571   }
4572
4573   $part_event_option->optionvalue;
4574
4575 }
4576
4577 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4578
4579 Subroutine (not a method), designed to be called from the queue.
4580
4581 Takes a list of options and values.
4582
4583 Pulls up the customer record via the custnum option and calls bill_and_collect.
4584
4585 =cut
4586
4587 sub queued_bill {
4588   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
4589
4590   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
4591   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
4592
4593   $cust_main->bill_and_collect( %args );
4594 }
4595
4596 sub process_bill_and_collect {
4597   my $job = shift;
4598   my $param = thaw(decode_base64(shift));
4599   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
4600       or die "custnum '$param->{custnum}' not found!\n";
4601   $param->{'job'}   = $job;
4602   $param->{'fatal'} = 1; # runs from job queue, will be caught
4603   $param->{'retry'} = 1;
4604
4605   $cust_main->bill_and_collect( %$param );
4606 }
4607
4608 sub _upgrade_data { #class method
4609   my ($class, %opts) = @_;
4610
4611   my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
4612   my $sth = dbh->prepare($sql) or die dbh->errstr;
4613   $sth->execute or die $sth->errstr;
4614
4615   local($ignore_expired_card) = 1;
4616   local($ignore_illegal_zip) = 1;
4617   local($ignore_banned_card) = 1;
4618   local($skip_fuzzyfiles) = 1;
4619   $class->_upgrade_otaker(%opts);
4620
4621 }
4622
4623 =back
4624
4625 =head1 BUGS
4626
4627 The delete method.
4628
4629 The delete method should possibly take an FS::cust_main object reference
4630 instead of a scalar customer number.
4631
4632 Bill and collect options should probably be passed as references instead of a
4633 list.
4634
4635 There should probably be a configuration file with a list of allowed credit
4636 card types.
4637
4638 No multiple currency support (probably a larger project than just this module).
4639
4640 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
4641
4642 Birthdates rely on negative epoch values.
4643
4644 The payby for card/check batches is broken.  With mixed batching, bad
4645 things will happen.
4646
4647 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
4648
4649 =head1 SEE ALSO
4650
4651 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
4652 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
4653 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
4654
4655 =cut
4656
4657 1;
4658