FS/FS/cust_main.pm

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