FS/FS/cust_main.pm

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