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