FS/FS/cust_main.pm

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