FS/FS/cust_main.pm

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