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
3329 Any other options are passed to FS::cust_credit::insert.
3330
3331 =cut
3332
3333 sub credit {
3334   my( $self, $amount, $reason, %options ) = @_;
3335
3336   my $cust_credit = new FS::cust_credit {
3337     'custnum' => $self->custnum,
3338     'amount'  => $amount,
3339   };
3340
3341   if ( ref($reason) ) {
3342
3343     if ( ref($reason) eq 'SCALAR' ) {
3344       $cust_credit->reasonnum( $$reason );
3345     } else {
3346       $cust_credit->reasonnum( $reason->reasonnum );
3347     }
3348
3349   } else {
3350     $cust_credit->set('reason', $reason)
3351   }
3352
3353   for (qw( addlinfo eventnum )) {
3354     $cust_credit->$_( delete $options{$_} )
3355       if exists($options{$_});
3356   }
3357
3358   $cust_credit->insert(%options);
3359
3360 }
3361
3362 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3363
3364 Creates a one-time charge for this customer.  If there is an error, returns
3365 the error, otherwise returns false.
3366
3367 New-style, with a hashref of options:
3368
3369   my $error = $cust_main->charge(
3370                                   {
3371                                     'amount'     => 54.32,
3372                                     'quantity'   => 1,
3373                                     'start_date' => str2time('7/4/2009'),
3374                                     'pkg'        => 'Description',
3375                                     'comment'    => 'Comment',
3376                                     'additional' => [], #extra invoice detail
3377                                     'classnum'   => 1,  #pkg_class
3378
3379                                     'setuptax'   => '', # or 'Y' for tax exempt
3380
3381                                     'locationnum'=> 1234, # optional
3382
3383                                     #internal taxation
3384                                     'taxclass'   => 'Tax class',
3385
3386                                     #vendor taxation
3387                                     'taxproduct' => 2,  #part_pkg_taxproduct
3388                                     'override'   => {}, #XXX describe
3389
3390                                     #will be filled in with the new object
3391                                     'cust_pkg_ref' => \$cust_pkg,
3392
3393                                     #generate an invoice immediately
3394                                     'bill_now' => 0,
3395                                     'invoice_terms' => '', #with these terms
3396                                   }
3397                                 );
3398
3399 Old-style:
3400
3401   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3402
3403 =cut
3404
3405 sub charge {
3406   my $self = shift;
3407   my ( $amount, $quantity, $start_date, $classnum );
3408   my ( $pkg, $comment, $additional );
3409   my ( $setuptax, $taxclass );   #internal taxes
3410   my ( $taxproduct, $override ); #vendor (CCH) taxes
3411   my $no_auto = '';
3412   my $cust_pkg_ref = '';
3413   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3414   my $locationnum;
3415   if ( ref( $_[0] ) ) {
3416     $amount     = $_[0]->{amount};
3417     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3418     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3419     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3420     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3421     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3422                                            : '$'. sprintf("%.2f",$amount);
3423     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3424     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3425     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3426     $additional = $_[0]->{additional} || [];
3427     $taxproduct = $_[0]->{taxproductnum};
3428     $override   = { '' => $_[0]->{tax_override} };
3429     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3430     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3431     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3432     $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3433   } else {
3434     $amount     = shift;
3435     $quantity   = 1;
3436     $start_date = '';
3437     $pkg        = @_ ? shift : 'One-time charge';
3438     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3439     $setuptax   = '';
3440     $taxclass   = @_ ? shift : '';
3441     $additional = [];
3442   }
3443
3444   local $SIG{HUP} = 'IGNORE';
3445   local $SIG{INT} = 'IGNORE';
3446   local $SIG{QUIT} = 'IGNORE';
3447   local $SIG{TERM} = 'IGNORE';
3448   local $SIG{TSTP} = 'IGNORE';
3449   local $SIG{PIPE} = 'IGNORE';
3450
3451   my $oldAutoCommit = $FS::UID::AutoCommit;
3452   local $FS::UID::AutoCommit = 0;
3453   my $dbh = dbh;
3454
3455   my $part_pkg = new FS::part_pkg ( {
3456     'pkg'           => $pkg,
3457     'comment'       => $comment,
3458     'plan'          => 'flat',
3459     'freq'          => 0,
3460     'disabled'      => 'Y',
3461     'classnum'      => ( $classnum ? $classnum : '' ),
3462     'setuptax'      => $setuptax,
3463     'taxclass'      => $taxclass,
3464     'taxproductnum' => $taxproduct,
3465   } );
3466
3467   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3468                         ( 0 .. @$additional - 1 )
3469                   ),
3470                   'additional_count' => scalar(@$additional),
3471                   'setup_fee' => $amount,
3472                 );
3473
3474   my $error = $part_pkg->insert( options       => \%options,
3475                                  tax_overrides => $override,
3476                                );
3477   if ( $error ) {
3478     $dbh->rollback if $oldAutoCommit;
3479     return $error;
3480   }
3481
3482   my $pkgpart = $part_pkg->pkgpart;
3483   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3484   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3485     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3486     $error = $type_pkgs->insert;
3487     if ( $error ) {
3488       $dbh->rollback if $oldAutoCommit;
3489       return $error;
3490     }
3491   }
3492
3493   my $cust_pkg = new FS::cust_pkg ( {
3494     'custnum'    => $self->custnum,
3495     'pkgpart'    => $pkgpart,
3496     'quantity'   => $quantity,
3497     'start_date' => $start_date,
3498     'no_auto'    => $no_auto,
3499     'locationnum'=> $locationnum,
3500   } );
3501
3502   $error = $cust_pkg->insert;
3503   if ( $error ) {
3504     $dbh->rollback if $oldAutoCommit;
3505     return $error;
3506   } elsif ( $cust_pkg_ref ) {
3507     ${$cust_pkg_ref} = $cust_pkg;
3508   }
3509
3510   if ( $bill_now ) {
3511     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3512                              'pkg_list'      => [ $cust_pkg ],
3513                            );
3514     if ( $error ) {
3515       $dbh->rollback if $oldAutoCommit;
3516       return $error;
3517     }
3518   }
3519
3520   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3521   return '';
3522
3523 }
3524
3525 #=item charge_postal_fee
3526 #
3527 #Applies a one time charge this customer.  If there is an error,
3528 #returns the error, returns the cust_pkg charge object or false
3529 #if there was no charge.
3530 #
3531 #=cut
3532 #
3533 # This should be a customer event.  For that to work requires that bill
3534 # also be a customer event.
3535
3536 sub charge_postal_fee {
3537   my $self = shift;
3538
3539   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3540   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3541
3542   my $cust_pkg = new FS::cust_pkg ( {
3543     'custnum'  => $self->custnum,
3544     'pkgpart'  => $pkgpart,
3545     'quantity' => 1,
3546   } );
3547
3548   my $error = $cust_pkg->insert;
3549   $error ? $error : $cust_pkg;
3550 }
3551
3552 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3553
3554 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3555
3556 Optionally, a list or hashref of additional arguments to the qsearch call can
3557 be passed.
3558
3559 =cut
3560
3561 sub cust_bill {
3562   my $self = shift;
3563   my $opt = ref($_[0]) ? shift : { @_ };
3564
3565   #return $self->num_cust_bill unless wantarray || keys %$opt;
3566
3567   $opt->{'table'} = 'cust_bill';
3568   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3569   $opt->{'hashref'}{'custnum'} = $self->custnum;
3570   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3571
3572   map { $_ } #behavior of sort undefined in scalar context
3573     sort { $a->_date <=> $b->_date }
3574       qsearch($opt);
3575 }
3576
3577 =item open_cust_bill
3578
3579 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3580 customer.
3581
3582 =cut
3583
3584 sub open_cust_bill {
3585   my $self = shift;
3586
3587   $self->cust_bill(
3588     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3589     #@_
3590   );
3591
3592 }
3593
3594 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3595
3596 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3597
3598 =cut
3599
3600 sub legacy_cust_bill {
3601   my $self = shift;
3602
3603   #return $self->num_legacy_cust_bill unless wantarray;
3604
3605   map { $_ } #behavior of sort undefined in scalar context
3606     sort { $a->_date <=> $b->_date }
3607       qsearch({ 'table'    => 'legacy_cust_bill',
3608                 'hashref'  => { 'custnum' => $self->custnum, },
3609                 'order_by' => 'ORDER BY _date ASC',
3610              });
3611 }
3612
3613 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3614
3615 Returns all the statements (see L<FS::cust_statement>) for this customer.
3616
3617 Optionally, a list or hashref of additional arguments to the qsearch call can
3618 be passed.
3619
3620 =cut
3621
3622 =item cust_bill_void
3623
3624 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3625
3626 =cut
3627
3628 sub cust_bill_void {
3629   my $self = shift;
3630
3631   map { $_ } #return $self->num_cust_bill_void unless wantarray;
3632   sort { $a->_date <=> $b->_date }
3633     qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3634 }
3635
3636 sub cust_statement {
3637   my $self = shift;
3638   my $opt = ref($_[0]) ? shift : { @_ };
3639
3640   #return $self->num_cust_statement unless wantarray || keys %$opt;
3641
3642   $opt->{'table'} = 'cust_statement';
3643   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3644   $opt->{'hashref'}{'custnum'} = $self->custnum;
3645   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3646
3647   map { $_ } #behavior of sort undefined in scalar context
3648     sort { $a->_date <=> $b->_date }
3649       qsearch($opt);
3650 }
3651
3652 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3653
3654 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3655
3656 Optionally, a list or hashref of additional arguments to the qsearch call can
3657 be passed following the SVCDB.
3658
3659 =cut
3660
3661 sub svc_x {
3662   my $self = shift;
3663   my $svcdb = shift;
3664   if ( ! $svcdb =~ /^svc_\w+$/ ) {
3665     warn "$me svc_x requires a svcdb";
3666     return;
3667   }
3668   my $opt = ref($_[0]) ? shift : { @_ };
3669
3670   $opt->{'table'} = $svcdb;
3671   $opt->{'addl_from'} =
3672     'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3673     ($opt->{'addl_from'} || '');
3674
3675   my $custnum = $self->custnum;
3676   $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3677   my $where = "cust_pkg.custnum = $custnum";
3678
3679   my $extra_sql = $opt->{'extra_sql'} || '';
3680   if ( keys %{ $opt->{'hashref'} } ) {
3681     $extra_sql = " AND $where $extra_sql";
3682   }
3683   else {
3684     if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3685       $extra_sql = "WHERE $where AND $1";
3686     }
3687     else {
3688       $extra_sql = "WHERE $where $extra_sql";
3689     }
3690   }
3691   $opt->{'extra_sql'} = $extra_sql;
3692
3693   qsearch($opt);
3694 }
3695
3696 # required for use as an eventtable;
3697 sub svc_acct {
3698   my $self = shift;
3699   $self->svc_x('svc_acct', @_);
3700 }
3701
3702 =item cust_credit
3703
3704 Returns all the credits (see L<FS::cust_credit>) for this customer.
3705
3706 =cut
3707
3708 sub cust_credit {
3709   my $self = shift;
3710   map { $_ } #return $self->num_cust_credit unless wantarray;
3711   sort { $a->_date <=> $b->_date }
3712     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3713 }
3714
3715 =item cust_credit_pkgnum
3716
3717 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3718 package when using experimental package balances.
3719
3720 =cut
3721
3722 sub cust_credit_pkgnum {
3723   my( $self, $pkgnum ) = @_;
3724   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3725   sort { $a->_date <=> $b->_date }
3726     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3727                               'pkgnum'  => $pkgnum,
3728                             }
3729     );
3730 }
3731
3732 =item cust_pay
3733
3734 Returns all the payments (see L<FS::cust_pay>) for this customer.
3735
3736 =cut
3737
3738 sub cust_pay {
3739   my $self = shift;
3740   return $self->num_cust_pay unless wantarray;
3741   sort { $a->_date <=> $b->_date }
3742     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3743 }
3744
3745 =item num_cust_pay
3746
3747 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3748 called automatically when the cust_pay method is used in a scalar context.
3749
3750 =cut
3751
3752 sub num_cust_pay {
3753   my $self = shift;
3754   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3755   my $sth = dbh->prepare($sql) or die dbh->errstr;
3756   $sth->execute($self->custnum) or die $sth->errstr;
3757   $sth->fetchrow_arrayref->[0];
3758 }
3759
3760 =item cust_pay_pkgnum
3761
3762 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3763 package when using experimental package balances.
3764
3765 =cut
3766
3767 sub cust_pay_pkgnum {
3768   my( $self, $pkgnum ) = @_;
3769   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3770   sort { $a->_date <=> $b->_date }
3771     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3772                            'pkgnum'  => $pkgnum,
3773                          }
3774     );
3775 }
3776
3777 =item cust_pay_void
3778
3779 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3780
3781 =cut
3782
3783 sub cust_pay_void {
3784   my $self = shift;
3785   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3786   sort { $a->_date <=> $b->_date }
3787     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3788 }
3789
3790 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3791
3792 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
3793
3794 Optionally, a list or hashref of additional arguments to the qsearch call can
3795 be passed.
3796
3797 =cut
3798
3799 sub cust_pay_batch {
3800   my $self = shift;
3801   my $opt = ref($_[0]) ? shift : { @_ };
3802
3803   #return $self->num_cust_statement unless wantarray || keys %$opt;
3804
3805   $opt->{'table'} = 'cust_pay_batch';
3806   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3807   $opt->{'hashref'}{'custnum'} = $self->custnum;
3808   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3809
3810   map { $_ } #behavior of sort undefined in scalar context
3811     sort { $a->paybatchnum <=> $b->paybatchnum }
3812       qsearch($opt);
3813 }
3814
3815 =item cust_pay_pending
3816
3817 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3818 (without status "done").
3819
3820 =cut
3821
3822 sub cust_pay_pending {
3823   my $self = shift;
3824   return $self->num_cust_pay_pending unless wantarray;
3825   sort { $a->_date <=> $b->_date }
3826     qsearch( 'cust_pay_pending', {
3827                                    'custnum' => $self->custnum,
3828                                    'status'  => { op=>'!=', value=>'done' },
3829                                  },
3830            );
3831 }
3832
3833 =item cust_pay_pending_attempt
3834
3835 Returns all payment attempts / declined payments for this customer, as pending
3836 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3837 a corresponding payment (see L<FS::cust_pay>).
3838
3839 =cut
3840
3841 sub cust_pay_pending_attempt {
3842   my $self = shift;
3843   return $self->num_cust_pay_pending_attempt unless wantarray;
3844   sort { $a->_date <=> $b->_date }
3845     qsearch( 'cust_pay_pending', {
3846                                    'custnum' => $self->custnum,
3847                                    'status'  => 'done',
3848                                    'paynum'  => '',
3849                                  },
3850            );
3851 }
3852
3853 =item num_cust_pay_pending
3854
3855 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3856 customer (without status "done").  Also called automatically when the
3857 cust_pay_pending method is used in a scalar context.
3858
3859 =cut
3860
3861 sub num_cust_pay_pending {
3862   my $self = shift;
3863   $self->scalar_sql(
3864     " SELECT COUNT(*) FROM cust_pay_pending ".
3865       " WHERE custnum = ? AND status != 'done' ",
3866     $self->custnum
3867   );
3868 }
3869
3870 =item num_cust_pay_pending_attempt
3871
3872 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3873 customer, with status "done" but without a corresp.  Also called automatically when the
3874 cust_pay_pending method is used in a scalar context.
3875
3876 =cut
3877
3878 sub num_cust_pay_pending_attempt {
3879   my $self = shift;
3880   $self->scalar_sql(
3881     " SELECT COUNT(*) FROM cust_pay_pending ".
3882       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3883     $self->custnum
3884   );
3885 }
3886
3887 =item cust_refund
3888
3889 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3890
3891 =cut
3892
3893 sub cust_refund {
3894   my $self = shift;
3895   map { $_ } #return $self->num_cust_refund unless wantarray;
3896   sort { $a->_date <=> $b->_date }
3897     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3898 }
3899
3900 =item display_custnum
3901
3902 Returns the displayed customer number for this customer: agent_custid if
3903 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3904
3905 =cut
3906
3907 sub display_custnum {
3908   my $self = shift;
3909
3910   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3911   if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3912     if ( $special eq 'CoStAg' ) {
3913       $prefix = uc( join('',
3914         $self->country,
3915         ($self->state =~ /^(..)/),
3916         $prefix || ($self->agent->agent =~ /^(..)/)
3917       ) );
3918     }
3919     elsif ( $special eq 'CoStCl' ) {
3920       $prefix = uc( join('',
3921         $self->country,
3922         ($self->state =~ /^(..)/),
3923         ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3924       ) );
3925     }
3926     # add any others here if needed
3927   }
3928
3929   my $length = $conf->config('cust_main-custnum-display_length');
3930   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3931     return $self->agent_custid;
3932   } elsif ( $prefix ) {
3933     $length = 8 if !defined($length);
3934     return $prefix .
3935            sprintf('%0'.$length.'d', $self->custnum)
3936   } elsif ( $length ) {
3937     return sprintf('%0'.$length.'d', $self->custnum);
3938   } else {
3939     return $self->custnum;
3940   }
3941 }
3942
3943 =item name
3944
3945 Returns a name string for this customer, either "Company (Last, First)" or
3946 "Last, First".
3947
3948 =cut
3949
3950 sub name {
3951   my $self = shift;
3952   my $name = $self->contact;
3953   $name = $self->company. " ($name)" if $self->company;
3954   $name;
3955 }
3956
3957 =item service_contact
3958
3959 Returns the L<FS::contact> object for this customer that has the 'Service'
3960 contact class, or undef if there is no such contact.  Deprecated; don't use
3961 this in new code.
3962
3963 =cut
3964
3965 sub service_contact {
3966   my $self = shift;
3967   if ( !exists($self->{service_contact}) ) {
3968     my $classnum = $self->scalar_sql(
3969       'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3970     ) || 0; #if it's zero, qsearchs will return nothing
3971     $self->{service_contact} = qsearchs('contact', {
3972         'classnum' => $classnum, 'custnum' => $self->custnum
3973       }) || undef;
3974   }
3975   $self->{service_contact};
3976 }
3977
3978 =item ship_name
3979
3980 Returns a name string for this (service/shipping) contact, either
3981 "Company (Last, First)" or "Last, First".
3982
3983 =cut
3984
3985 sub ship_name {
3986   my $self = shift;
3987
3988   my $name = $self->ship_contact;
3989   $name = $self->company. " ($name)" if $self->company;
3990   $name;
3991 }
3992
3993 =item name_short
3994
3995 Returns a name string for this customer, either "Company" or "First Last".
3996
3997 =cut
3998
3999 sub name_short {
4000   my $self = shift;
4001   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4002 }
4003
4004 =item ship_name_short
4005
4006 Returns a name string for this (service/shipping) contact, either "Company"
4007 or "First Last".
4008
4009 =cut
4010
4011 sub ship_name_short {
4012   my $self = shift;
4013   $self->service_contact
4014     ? $self->ship_contact_firstlast
4015     : $self->name_short
4016 }
4017
4018 =item contact
4019
4020 Returns this customer's full (billing) contact name only, "Last, First"
4021
4022 =cut
4023
4024 sub contact {
4025   my $self = shift;
4026   $self->get('last'). ', '. $self->first;
4027 }
4028
4029 =item ship_contact
4030
4031 Returns this customer's full (shipping) contact name only, "Last, First"
4032
4033 =cut
4034
4035 sub ship_contact {
4036   my $self = shift;
4037   my $contact = $self->service_contact || $self;
4038   $contact->get('last') . ', ' . $contact->get('first');
4039 }
4040
4041 =item contact_firstlast
4042
4043 Returns this customers full (billing) contact name only, "First Last".
4044
4045 =cut
4046
4047 sub contact_firstlast {
4048   my $self = shift;
4049   $self->first. ' '. $self->get('last');
4050 }
4051
4052 =item ship_contact_firstlast
4053
4054 Returns this customer's full (shipping) contact name only, "First Last".
4055
4056 =cut
4057
4058 sub ship_contact_firstlast {
4059   my $self = shift;
4060   my $contact = $self->service_contact || $self;
4061   $contact->get('first') . ' '. $contact->get('last');
4062 }
4063
4064 #XXX this doesn't work in 3.x+
4065 #=item country_full
4066 #
4067 #Returns this customer's full country name
4068 #
4069 #=cut
4070 #
4071 #sub country_full {
4072 #  my $self = shift;
4073 #  code2country($self->country);
4074 #}
4075
4076 =item county_state_county [ PREFIX ]
4077
4078 Returns a string consisting of just the county, state and country.
4079
4080 =cut
4081
4082 sub county_state_country {
4083   my $self = shift;
4084   my $locationnum;
4085   if ( @_ && $_[0] && $self->has_ship_address ) {
4086     $locationnum = $self->ship_locationnum;
4087   } else {
4088     $locationnum = $self->bill_locationnum;
4089   }
4090   my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4091   $cust_location->county_state_country;
4092 }
4093
4094 =item geocode DATA_VENDOR
4095
4096 Returns a value for the customer location as encoded by DATA_VENDOR.
4097 Currently this only makes sense for "CCH" as DATA_VENDOR.
4098
4099 =cut
4100
4101 =item cust_status
4102
4103 =item status
4104
4105 Returns a status string for this customer, currently:
4106
4107 =over 4
4108
4109 =item prospect - No packages have ever been ordered
4110
4111 =item ordered - Recurring packages all are new (not yet billed).
4112
4113 =item active - One or more recurring packages is active
4114
4115 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4116
4117 =item suspended - All non-cancelled recurring packages are suspended
4118
4119 =item cancelled - All recurring packages are cancelled
4120
4121 =back
4122
4123 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4124 cust_main-status_module configuration option.
4125
4126 =cut
4127
4128 sub status { shift->cust_status(@_); }
4129
4130 sub cust_status {
4131   my $self = shift;
4132   for my $status ( FS::cust_main->statuses() ) {
4133     my $method = $status.'_sql';
4134     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4135     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4136     $sth->execute( ($self->custnum) x $numnum )
4137       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4138     return $status if $sth->fetchrow_arrayref->[0];
4139   }
4140 }
4141
4142 =item ucfirst_cust_status
4143
4144 =item ucfirst_status
4145
4146 Returns the status with the first character capitalized.
4147
4148 =cut
4149
4150 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4151
4152 sub ucfirst_cust_status {
4153   my $self = shift;
4154   ucfirst($self->cust_status);
4155 }
4156
4157 =item statuscolor
4158
4159 Returns a hex triplet color string for this customer's status.
4160
4161 =cut
4162
4163 sub statuscolor { shift->cust_statuscolor(@_); }
4164
4165 sub cust_statuscolor {
4166   my $self = shift;
4167   __PACKAGE__->statuscolors->{$self->cust_status};
4168 }
4169
4170 =item tickets
4171
4172 Returns an array of hashes representing the customer's RT tickets.
4173
4174 =cut
4175
4176 sub tickets {
4177   my $self = shift;
4178
4179   my $num = $conf->config('cust_main-max_tickets') || 10;
4180   my @tickets = ();
4181
4182   if ( $conf->config('ticket_system') ) {
4183     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4184
4185       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
4186
4187     } else {
4188
4189       foreach my $priority (
4190         $conf->config('ticket_system-custom_priority_field-values'), ''
4191       ) {
4192         last if scalar(@tickets) >= $num;
4193         push @tickets,
4194           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4195                                                  $num - scalar(@tickets),
4196                                                  $priority,
4197                                                )
4198            };
4199       }
4200     }
4201   }
4202   (@tickets);
4203 }
4204
4205 # Return services representing svc_accts in customer support packages
4206 sub support_services {
4207   my $self = shift;
4208   my %packages = map { $_ => 1 } $conf->config('support_packages');
4209
4210   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4211     grep { $_->part_svc->svcdb eq 'svc_acct' }
4212     map { $_->cust_svc }
4213     grep { exists $packages{ $_->pkgpart } }
4214     $self->ncancelled_pkgs;
4215
4216 }
4217
4218 # Return a list of latitude/longitude for one of the services (if any)
4219 sub service_coordinates {
4220   my $self = shift;
4221
4222   my @svc_X =
4223     grep { $_->latitude && $_->longitude }
4224     map { $_->svc_x }
4225     map { $_->cust_svc }
4226     $self->ncancelled_pkgs;
4227
4228   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4229 }
4230
4231 =item masked FIELD
4232
4233 Returns a masked version of the named field
4234
4235 =cut
4236
4237 sub masked {
4238 my ($self,$field) = @_;
4239
4240 # Show last four
4241
4242 'x'x(length($self->getfield($field))-4).
4243   substr($self->getfield($field), (length($self->getfield($field))-4));
4244
4245 }
4246
4247 =back
4248
4249 =head1 CLASS METHODS
4250
4251 =over 4
4252
4253 =item statuses
4254
4255 Class method that returns the list of possible status strings for customers
4256 (see L<the status method|/status>).  For example:
4257
4258   @statuses = FS::cust_main->statuses();
4259
4260 =cut
4261
4262 sub statuses {
4263   my $self = shift;
4264   keys %{ $self->statuscolors };
4265 }
4266
4267 =item cust_status_sql
4268
4269 Returns an SQL fragment to determine the status of a cust_main record, as a
4270 string.
4271
4272 =cut
4273
4274 sub cust_status_sql {
4275   my $sql = 'CASE';
4276   for my $status ( FS::cust_main->statuses() ) {
4277     my $method = $status.'_sql';
4278     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4279   }
4280   $sql .= ' END';
4281   return $sql;
4282 }
4283
4284
4285 =item prospect_sql
4286
4287 Returns an SQL expression identifying prospective cust_main records (customers
4288 with no packages ever ordered)
4289
4290 =cut
4291
4292 use vars qw($select_count_pkgs);
4293 $select_count_pkgs =
4294   "SELECT COUNT(*) FROM cust_pkg
4295     WHERE cust_pkg.custnum = cust_main.custnum";
4296
4297 sub select_count_pkgs_sql {
4298   $select_count_pkgs;
4299 }
4300
4301 sub prospect_sql {
4302   " 0 = ( $select_count_pkgs ) ";
4303 }
4304
4305 =item ordered_sql
4306
4307 Returns an SQL expression identifying ordered cust_main records (customers with
4308 no active packages, but recurring packages not yet setup or one time charges
4309 not yet billed).
4310
4311 =cut
4312
4313 sub ordered_sql {
4314   FS::cust_main->none_active_sql.
4315   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4316 }
4317
4318 =item active_sql
4319
4320 Returns an SQL expression identifying active cust_main records (customers with
4321 active recurring packages).
4322
4323 =cut
4324
4325 sub active_sql {
4326   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4327 }
4328
4329 =item none_active_sql
4330
4331 Returns an SQL expression identifying cust_main records with no active
4332 recurring packages.  This includes customers of status prospect, ordered,
4333 inactive, and suspended.
4334
4335 =cut
4336
4337 sub none_active_sql {
4338   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4339 }
4340
4341 =item inactive_sql
4342
4343 Returns an SQL expression identifying inactive cust_main records (customers with
4344 no active recurring packages, but otherwise unsuspended/uncancelled).
4345
4346 =cut
4347
4348 sub inactive_sql {
4349   FS::cust_main->none_active_sql.
4350   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4351 }
4352
4353 =item susp_sql
4354 =item suspended_sql
4355
4356 Returns an SQL expression identifying suspended cust_main records.
4357
4358 =cut
4359
4360
4361 sub suspended_sql { susp_sql(@_); }
4362 sub susp_sql {
4363   FS::cust_main->none_active_sql.
4364   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4365 }
4366
4367 =item cancel_sql
4368 =item cancelled_sql
4369
4370 Returns an SQL expression identifying cancelled cust_main records.
4371
4372 =cut
4373
4374 sub cancel_sql { shift->cancelled_sql(@_); }
4375
4376 =item uncancel_sql
4377 =item uncancelled_sql
4378
4379 Returns an SQL expression identifying un-cancelled cust_main records.
4380
4381 =cut
4382
4383 sub uncancelled_sql { uncancel_sql(@_); }
4384 sub uncancel_sql { "
4385   ( 0 < ( $select_count_pkgs
4386                    AND ( cust_pkg.cancel IS NULL
4387                          OR cust_pkg.cancel = 0
4388                        )
4389         )
4390     OR 0 = ( $select_count_pkgs )
4391   )
4392 "; }
4393
4394 =item balance_sql
4395
4396 Returns an SQL fragment to retreive the balance.
4397
4398 =cut
4399
4400 sub balance_sql { "
4401     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4402         WHERE cust_bill.custnum   = cust_main.custnum     )
4403   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4404         WHERE cust_pay.custnum    = cust_main.custnum     )
4405   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4406         WHERE cust_credit.custnum = cust_main.custnum     )
4407   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4408         WHERE cust_refund.custnum = cust_main.custnum     )
4409 "; }
4410
4411 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4412
4413 Returns an SQL fragment to retreive the balance for this customer, optionally
4414 considering invoices with date earlier than START_TIME, and not
4415 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4416 total_unapplied_payments).
4417
4418 Times are specified as SQL fragments or numeric
4419 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4420 L<Date::Parse> for conversion functions.  The empty string can be passed
4421 to disable that time constraint completely.
4422
4423 Available options are:
4424
4425 =over 4
4426
4427 =item unapplied_date
4428
4429 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)
4430
4431 =item total
4432
4433 (unused.  obsolete?)
4434 set to true to remove all customer comparison clauses, for totals
4435
4436 =item where
4437
4438 (unused.  obsolete?)
4439 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4440
4441 =item join
4442
4443 (unused.  obsolete?)
4444 JOIN clause (typically used with the total option)
4445
4446 =item cutoff
4447
4448 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4449 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4450 range for invoices and I<unapplied> payments, credits, and refunds.
4451
4452 =back
4453
4454 =cut
4455
4456 sub balance_date_sql {
4457   my( $class, $start, $end, %opt ) = @_;
4458
4459   my $cutoff = $opt{'cutoff'};
4460
4461   my $owed         = FS::cust_bill->owed_sql($cutoff);
4462   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4463   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4464   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4465
4466   my $j = $opt{'join'} || '';
4467
4468   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4469   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4470   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4471   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4472
4473   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4474     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4475     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4476     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4477   ";
4478
4479 }
4480
4481 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4482
4483 Returns an SQL fragment to retreive the total unapplied payments for this
4484 customer, only considering payments with date earlier than START_TIME, and
4485 optionally not later than END_TIME.
4486
4487 Times are specified as SQL fragments or numeric
4488 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4489 L<Date::Parse> for conversion functions.  The empty string can be passed
4490 to disable that time constraint completely.
4491
4492 Available options are:
4493
4494 =cut
4495
4496 sub unapplied_payments_date_sql {
4497   my( $class, $start, $end, %opt ) = @_;
4498
4499   my $cutoff = $opt{'cutoff'};
4500
4501   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4502
4503   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4504                                                           'unapplied_date'=>1 );
4505
4506   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4507 }
4508
4509 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4510
4511 Helper method for balance_date_sql; name (and usage) subject to change
4512 (suggestions welcome).
4513
4514 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4515 cust_refund, cust_credit or cust_pay).
4516
4517 If TABLE is "cust_bill" or the unapplied_date option is true, only
4518 considers records with date earlier than START_TIME, and optionally not
4519 later than END_TIME .
4520
4521 =cut
4522
4523 sub _money_table_where {
4524   my( $class, $table, $start, $end, %opt ) = @_;
4525
4526   my @where = ();
4527   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4528   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4529     push @where, "$table._date <= $start" if defined($start) && length($start);
4530     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4531   }
4532   push @where, @{$opt{'where'}} if $opt{'where'};
4533   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4534
4535   $where;
4536
4537 }
4538
4539 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4540 use FS::cust_main::Search;
4541 sub search {
4542   my $class = shift;
4543   FS::cust_main::Search->search(@_);
4544 }
4545
4546 =back
4547
4548 =head1 SUBROUTINES
4549
4550 =over 4
4551
4552 =item batch_charge
4553
4554 =cut
4555
4556 sub batch_charge {
4557   my $param = shift;
4558   #warn join('-',keys %$param);
4559   my $fh = $param->{filehandle};
4560   my $agentnum = $param->{agentnum};
4561   my $format = $param->{format};
4562
4563   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4564
4565   my @fields;
4566   if ( $format eq 'simple' ) {
4567     @fields = qw( custnum agent_custid amount pkg );
4568   } else {
4569     die "unknown format $format";
4570   }
4571
4572   eval "use Text::CSV_XS;";
4573   die $@ if $@;
4574
4575   my $csv = new Text::CSV_XS;
4576   #warn $csv;
4577   #warn $fh;
4578
4579   my $imported = 0;
4580   #my $columns;
4581
4582   local $SIG{HUP} = 'IGNORE';
4583   local $SIG{INT} = 'IGNORE';
4584   local $SIG{QUIT} = 'IGNORE';
4585   local $SIG{TERM} = 'IGNORE';
4586   local $SIG{TSTP} = 'IGNORE';
4587   local $SIG{PIPE} = 'IGNORE';
4588
4589   my $oldAutoCommit = $FS::UID::AutoCommit;
4590   local $FS::UID::AutoCommit = 0;
4591   my $dbh = dbh;
4592
4593   #while ( $columns = $csv->getline($fh) ) {
4594   my $line;
4595   while ( defined($line=<$fh>) ) {
4596
4597     $csv->parse($line) or do {
4598       $dbh->rollback if $oldAutoCommit;
4599       return "can't parse: ". $csv->error_input();
4600     };
4601
4602     my @columns = $csv->fields();
4603     #warn join('-',@columns);
4604
4605     my %row = ();
4606     foreach my $field ( @fields ) {
4607       $row{$field} = shift @columns;
4608     }
4609
4610     if ( $row{custnum} && $row{agent_custid} ) {
4611       dbh->rollback if $oldAutoCommit;
4612       return "can't specify custnum with agent_custid $row{agent_custid}";
4613     }
4614
4615     my %hash = ();
4616     if ( $row{agent_custid} && $agentnum ) {
4617       %hash = ( 'agent_custid' => $row{agent_custid},
4618                 'agentnum'     => $agentnum,
4619               );
4620     }
4621
4622     if ( $row{custnum} ) {
4623       %hash = ( 'custnum' => $row{custnum} );
4624     }
4625
4626     unless ( scalar(keys %hash) ) {
4627       $dbh->rollback if $oldAutoCommit;
4628       return "can't find customer without custnum or agent_custid and agentnum";
4629     }
4630
4631     my $cust_main = qsearchs('cust_main', { %hash } );
4632     unless ( $cust_main ) {
4633       $dbh->rollback if $oldAutoCommit;
4634       my $custnum = $row{custnum} || $row{agent_custid};
4635       return "unknown custnum $custnum";
4636     }
4637
4638     if ( $row{'amount'} > 0 ) {
4639       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4640       if ( $error ) {
4641         $dbh->rollback if $oldAutoCommit;
4642         return $error;
4643       }
4644       $imported++;
4645     } elsif ( $row{'amount'} < 0 ) {
4646       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4647                                       $row{'pkg'}                         );
4648       if ( $error ) {
4649         $dbh->rollback if $oldAutoCommit;
4650         return $error;
4651       }
4652       $imported++;
4653     } else {
4654       #hmm?
4655     }
4656
4657   }
4658
4659   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4660
4661   return "Empty file!" unless $imported;
4662
4663   ''; #no error
4664
4665 }
4666
4667 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4668
4669 Deprecated.  Use event notification and message templates
4670 (L<FS::msg_template>) instead.
4671
4672 Sends a templated email notification to the customer (see L<Text::Template>).
4673
4674 OPTIONS is a hash and may include
4675
4676 I<from> - the email sender (default is invoice_from)
4677
4678 I<to> - comma-separated scalar or arrayref of recipients
4679    (default is invoicing_list)
4680
4681 I<subject> - The subject line of the sent email notification
4682    (default is "Notice from company_name")
4683
4684 I<extra_fields> - a hashref of name/value pairs which will be substituted
4685    into the template
4686
4687 The following variables are vavailable in the template.
4688
4689 I<$first> - the customer first name
4690 I<$last> - the customer last name
4691 I<$company> - the customer company
4692 I<$payby> - a description of the method of payment for the customer
4693             # would be nice to use FS::payby::shortname
4694 I<$payinfo> - the account information used to collect for this customer
4695 I<$expdate> - the expiration of the customer payment in seconds from epoch
4696
4697 =cut
4698
4699 sub notify {
4700   my ($self, $template, %options) = @_;
4701
4702   return unless $conf->exists($template);
4703
4704   my $from = $conf->config('invoice_from', $self->agentnum)
4705     if $conf->exists('invoice_from', $self->agentnum);
4706   $from = $options{from} if exists($options{from});
4707
4708   my $to = join(',', $self->invoicing_list_emailonly);
4709   $to = $options{to} if exists($options{to});
4710
4711   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4712     if $conf->exists('company_name', $self->agentnum);
4713   $subject = $options{subject} if exists($options{subject});
4714
4715   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4716                                             SOURCE => [ map "$_\n",
4717                                               $conf->config($template)]
4718                                            )
4719     or die "can't create new Text::Template object: Text::Template::ERROR";
4720   $notify_template->compile()
4721     or die "can't compile template: Text::Template::ERROR";
4722
4723   $FS::notify_template::_template::company_name =
4724     $conf->config('company_name', $self->agentnum);
4725   $FS::notify_template::_template::company_address =
4726     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4727
4728   my $paydate = $self->paydate || '2037-12-31';
4729   $FS::notify_template::_template::first = $self->first;
4730   $FS::notify_template::_template::last = $self->last;
4731   $FS::notify_template::_template::company = $self->company;
4732   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4733   my $payby = $self->payby;
4734   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4735   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4736
4737   #credit cards expire at the end of the month/year of their exp date
4738   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4739     $FS::notify_template::_template::payby = 'credit card';
4740     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4741     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4742     $expire_time--;
4743   }elsif ($payby eq 'COMP') {
4744     $FS::notify_template::_template::payby = 'complimentary account';
4745   }else{
4746     $FS::notify_template::_template::payby = 'current method';
4747   }
4748   $FS::notify_template::_template::expdate = $expire_time;
4749
4750   for (keys %{$options{extra_fields}}){
4751     no strict "refs";
4752     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4753   }
4754
4755   send_email(from => $from,
4756              to => $to,
4757              subject => $subject,
4758              body => $notify_template->fill_in( PACKAGE =>
4759                                                 'FS::notify_template::_template'                                              ),
4760             );
4761
4762 }
4763
4764 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4765
4766 Generates a templated notification to the customer (see L<Text::Template>).
4767
4768 OPTIONS is a hash and may include
4769
4770 I<extra_fields> - a hashref of name/value pairs which will be substituted
4771    into the template.  These values may override values mentioned below
4772    and those from the customer record.
4773
4774 The following variables are available in the template instead of or in addition
4775 to the fields of the customer record.
4776
4777 I<$payby> - a description of the method of payment for the customer
4778             # would be nice to use FS::payby::shortname
4779 I<$payinfo> - the masked account information used to collect for this customer
4780 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4781 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4782
4783 =cut
4784
4785 # a lot like cust_bill::print_latex
4786 sub generate_letter {
4787   my ($self, $template, %options) = @_;
4788
4789   return unless $conf->exists($template);
4790
4791   my $letter_template = new Text::Template
4792                         ( TYPE       => 'ARRAY',
4793                           SOURCE     => [ map "$_\n", $conf->config($template)],
4794                           DELIMITERS => [ '[@--', '--@]' ],
4795                         )
4796     or die "can't create new Text::Template object: Text::Template::ERROR";
4797
4798   $letter_template->compile()
4799     or die "can't compile template: Text::Template::ERROR";
4800
4801   my %letter_data = map { $_ => $self->$_ } $self->fields;
4802   $letter_data{payinfo} = $self->mask_payinfo;
4803
4804   #my $paydate = $self->paydate || '2037-12-31';
4805   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4806
4807   my $payby = $self->payby;
4808   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4809   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4810
4811   #credit cards expire at the end of the month/year of their exp date
4812   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4813     $letter_data{payby} = 'credit card';
4814     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4815     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4816     $expire_time--;
4817   }elsif ($payby eq 'COMP') {
4818     $letter_data{payby} = 'complimentary account';
4819   }else{
4820     $letter_data{payby} = 'current method';
4821   }
4822   $letter_data{expdate} = $expire_time;
4823
4824   for (keys %{$options{extra_fields}}){
4825     $letter_data{$_} = $options{extra_fields}->{$_};
4826   }
4827
4828   unless(exists($letter_data{returnaddress})){
4829     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4830                                                   $self->agent_template)
4831                      );
4832     if ( length($retadd) ) {
4833       $letter_data{returnaddress} = $retadd;
4834     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4835       $letter_data{returnaddress} =
4836         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4837                           s/$/\\\\\*/;
4838                           $_;
4839                         }
4840                     ( $conf->config('company_name', $self->agentnum),
4841                       $conf->config('company_address', $self->agentnum),
4842                     )
4843         );
4844     } else {
4845       $letter_data{returnaddress} = '~';
4846     }
4847   }
4848
4849   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4850
4851   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4852
4853   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4854
4855   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4856                            DIR      => $dir,
4857                            SUFFIX   => '.eps',
4858                            UNLINK   => 0,
4859                          ) or die "can't open temp file: $!\n";
4860   print $lh $conf->config_binary('logo.eps', $self->agentnum)
4861     or die "can't write temp file: $!\n";
4862   close $lh;
4863   $letter_data{'logo_file'} = $lh->filename;
4864
4865   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4866                            DIR      => $dir,
4867                            SUFFIX   => '.tex',
4868                            UNLINK   => 0,
4869                          ) or die "can't open temp file: $!\n";
4870
4871   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4872   close $fh;
4873   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4874   return ($1, $letter_data{'logo_file'});
4875
4876 }
4877
4878 =item print_ps TEMPLATE
4879
4880 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4881
4882 =cut
4883
4884 sub print_ps {
4885   my $self = shift;
4886   my($file, $lfile) = $self->generate_letter(@_);
4887   my $ps = FS::Misc::generate_ps($file);
4888   unlink($file.'.tex');
4889   unlink($lfile);
4890
4891   $ps;
4892 }
4893
4894 =item print TEMPLATE
4895
4896 Prints the filled in template.
4897
4898 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4899
4900 =cut
4901
4902 sub queueable_print {
4903   my %opt = @_;
4904
4905   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4906     or die "invalid customer number: " . $opt{custvnum};
4907
4908   my $error = $self->print( $opt{template} );
4909   die $error if $error;
4910 }
4911
4912 sub print {
4913   my ($self, $template) = (shift, shift);
4914   do_print(
4915     [ $self->print_ps($template) ],
4916     'agentnum' => $self->agentnum,
4917   );
4918 }
4919
4920 #these three subs should just go away once agent stuff is all config overrides
4921
4922 sub agent_template {
4923   my $self = shift;
4924   $self->_agent_plandata('agent_templatename');
4925 }
4926
4927 sub agent_invoice_from {
4928   my $self = shift;
4929   $self->_agent_plandata('agent_invoice_from');
4930 }
4931
4932 sub _agent_plandata {
4933   my( $self, $option ) = @_;
4934
4935   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
4936   #agent-specific Conf
4937
4938   use FS::part_event::Condition;
4939
4940   my $agentnum = $self->agentnum;
4941
4942   my $regexp = regexp_sql();
4943
4944   my $part_event_option =
4945     qsearchs({
4946       'select'    => 'part_event_option.*',
4947       'table'     => 'part_event_option',
4948       'addl_from' => q{
4949         LEFT JOIN part_event USING ( eventpart )
4950         LEFT JOIN part_event_option AS peo_agentnum
4951           ON ( part_event.eventpart = peo_agentnum.eventpart
4952                AND peo_agentnum.optionname = 'agentnum'
4953                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4954              )
4955         LEFT JOIN part_event_condition
4956           ON ( part_event.eventpart = part_event_condition.eventpart
4957                AND part_event_condition.conditionname = 'cust_bill_age'
4958              )
4959         LEFT JOIN part_event_condition_option
4960           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4961                AND part_event_condition_option.optionname = 'age'
4962              )
4963       },
4964       #'hashref'   => { 'optionname' => $option },
4965       #'hashref'   => { 'part_event_option.optionname' => $option },
4966       'extra_sql' =>
4967         " WHERE part_event_option.optionname = ". dbh->quote($option).
4968         " AND action = 'cust_bill_send_agent' ".
4969         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4970         " AND peo_agentnum.optionname = 'agentnum' ".
4971         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4972         " ORDER BY
4973            CASE WHEN part_event_condition_option.optionname IS NULL
4974            THEN -1
4975            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4976         " END
4977           , part_event.weight".
4978         " LIMIT 1"
4979     });
4980
4981   unless ( $part_event_option ) {
4982     return $self->agent->invoice_template || ''
4983       if $option eq 'agent_templatename';
4984     return '';
4985   }
4986
4987   $part_event_option->optionvalue;
4988
4989 }
4990
4991 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4992
4993 Subroutine (not a method), designed to be called from the queue.
4994
4995 Takes a list of options and values.
4996
4997 Pulls up the customer record via the custnum option and calls bill_and_collect.
4998
4999 =cut
5000
5001 sub queued_bill {
5002   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5003
5004   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5005   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5006
5007   $cust_main->bill_and_collect( %args );
5008 }
5009
5010 sub process_bill_and_collect {
5011   my $job = shift;
5012   my $param = thaw(decode_base64(shift));
5013   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5014       or die "custnum '$param->{custnum}' not found!\n";
5015   $param->{'job'}   = $job;
5016   $param->{'fatal'} = 1; # runs from job queue, will be caught
5017   $param->{'retry'} = 1;
5018
5019   $cust_main->bill_and_collect( %$param );
5020 }
5021
5022 #starting to take quite a while for big dbs
5023 #   (JRNL: journaled so it only happens once per database)
5024 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5025 # JRNL seq scan of cust_main on signupdate... index signupdate?  will that help?
5026 # JRNL seq scan of cust_main on paydate... index on substrings?  maybe set an
5027 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5028 # JRNL leading/trailing spaces in first, last, company
5029 # - otaker upgrade?  journal and call it good?  (double check to make sure
5030 #    we're not still setting otaker here)
5031 #
5032 #only going to get worse with new location stuff...
5033
5034 sub _upgrade_data { #class method
5035   my ($class, %opts) = @_;
5036
5037   my @statements = (
5038     'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5039   );
5040
5041   #this seems to be the only expensive one.. why does it take so long?
5042   unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5043     push @statements,
5044       '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';
5045     FS::upgrade_journal->set_done('cust_main__signupdate');
5046   }
5047
5048   unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5049
5050     # fix yyyy-m-dd formatted paydates
5051     if ( driver_name =~ /^mysql/i ) {
5052       push @statements,
5053       "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5054     } else { # the SQL standard
5055       push @statements,
5056       "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5057     }
5058     FS::upgrade_journal->set_done('cust_main__paydate');
5059   }
5060
5061   unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5062
5063     push @statements, #fix the weird BILL with a cc# in payinfo problem
5064       #DCRD to be safe
5065       "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5066
5067     FS::upgrade_journal->set_done('cust_main__payinfo');
5068
5069   }
5070
5071   my $t = time;
5072   foreach my $sql ( @statements ) {
5073     my $sth = dbh->prepare($sql) or die dbh->errstr;
5074     $sth->execute or die $sth->errstr;
5075     #warn ( (time - $t). " seconds\n" );
5076     #$t = time;
5077   }
5078
5079   local($ignore_expired_card) = 1;
5080   local($ignore_banned_card) = 1;
5081   local($skip_fuzzyfiles) = 1;
5082   local($import) = 1; #prevent automatic geocoding (need its own variable?)
5083
5084   FS::cust_main::Location->_upgrade_data(%opts);
5085
5086   unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5087
5088     foreach my $cust_main ( qsearch({
5089       'table'     => 'cust_main',
5090       'hashref'   => {},
5091       'extra_sql' => 'WHERE '.
5092                        join(' OR ',
5093                          map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '%  %'",
5094                            qw( first last company )
5095                        ),
5096     }) ) {
5097       my $error = $cust_main->replace;
5098       die $error if $error;
5099     }
5100
5101     FS::upgrade_journal->set_done('cust_main__trimspaces');
5102
5103   }
5104
5105   $class->_upgrade_otaker(%opts);
5106
5107 }
5108
5109 =back
5110
5111 =head1 BUGS
5112
5113 The delete method.
5114
5115 The delete method should possibly take an FS::cust_main object reference
5116 instead of a scalar customer number.
5117
5118 Bill and collect options should probably be passed as references instead of a
5119 list.
5120
5121 There should probably be a configuration file with a list of allowed credit
5122 card types.
5123
5124 No multiple currency support (probably a larger project than just this module).
5125
5126 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5127
5128 Birthdates rely on negative epoch values.
5129
5130 The payby for card/check batches is broken.  With mixed batching, bad
5131 things will happen.
5132
5133 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5134
5135 =head1 SEE ALSO
5136
5137 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5138 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5139 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5140
5141 =cut
5142
5143 1;
5144