FS/FS/cust_main.pm

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