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