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