FS/FS/cust_main.pm

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