FS/FS/cust_main.pm

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