FS/FS/cust_main.pm

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