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