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     $self->payname =~ /^([\w \,\.\-\'\&]*)$/
2034       or return gettext('illegal_name'). " payname: ". $self->payname;
2035     $self->payname($1);
2036   }
2037
2038   ### end of stuff moved to cust_payby
2039
2040   return "Please select an invoicing locale"
2041     if ! $self->locale
2042     && ! $self->custnum
2043     && $conf->exists('cust_main-require_locale');
2044
2045   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2046     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2047     $self->$flag($1);
2048   }
2049
2050   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2051
2052   warn "$me check AFTER: \n". $self->_dump
2053     if $DEBUG > 2;
2054
2055   $self->SUPER::check;
2056 }
2057
2058 =item addr_fields
2059
2060 Returns a list of fields which have ship_ duplicates.
2061
2062 =cut
2063
2064 sub addr_fields {
2065   qw( last first company
2066       address1 address2 city county state zip country
2067       latitude longitude
2068       daytime night fax mobile
2069     );
2070 }
2071
2072 =item has_ship_address
2073
2074 Returns true if this customer record has a separate shipping address.
2075
2076 =cut
2077
2078 sub has_ship_address {
2079   my $self = shift;
2080   $self->bill_locationnum != $self->ship_locationnum;
2081 }
2082
2083 =item location_hash
2084
2085 Returns a list of key/value pairs, with the following keys: address1,
2086 adddress2, city, county, state, zip, country, district, and geocode.  The
2087 shipping address is used if present.
2088
2089 =cut
2090
2091 sub location_hash {
2092   my $self = shift;
2093   $self->ship_location->location_hash;
2094 }
2095
2096 =item cust_location
2097
2098 Returns all locations (see L<FS::cust_location>) for this customer.
2099
2100 =cut
2101
2102 sub cust_location {
2103   my $self = shift;
2104   qsearch('cust_location', { 'custnum'     => $self->custnum,
2105                              'prospectnum' => '' } );
2106 }
2107
2108 =item cust_contact
2109
2110 Returns all contacts (see L<FS::contact>) for this customer.
2111
2112 =cut
2113
2114 #already used :/ sub contact {
2115 sub cust_contact {
2116   my $self = shift;
2117   qsearch('contact', { 'custnum' => $self->custnum } );
2118 }
2119
2120 =item cust_payby
2121
2122 Returns all payment methods (see L<FS::cust_payby>) for this customer.
2123
2124 =cut
2125
2126 sub cust_payby {
2127   my $self = shift;
2128   qsearch({
2129     'table'    => 'cust_payby',
2130     'hashref'  => { 'custnum' => $self->custnum },
2131     'order_by' => 'ORDER BY weight ASC',
2132   });
2133 }
2134
2135 =item unsuspend
2136
2137 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2138 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
2139 on success or a list of errors.
2140
2141 =cut
2142
2143 sub unsuspend {
2144   my $self = shift;
2145   grep { $_->unsuspend } $self->suspended_pkgs;
2146 }
2147
2148 =item suspend
2149
2150 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2151
2152 Returns a list: an empty list on success or a list of errors.
2153
2154 =cut
2155
2156 sub suspend {
2157   my $self = shift;
2158   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2159 }
2160
2161 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2162
2163 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2164 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2165 of a list of pkgparts; the hashref has the following keys:
2166
2167 =over 4
2168
2169 =item pkgparts - listref of pkgparts
2170
2171 =item (other options are passed to the suspend method)
2172
2173 =back
2174
2175
2176 Returns a list: an empty list on success or a list of errors.
2177
2178 =cut
2179
2180 sub suspend_if_pkgpart {
2181   my $self = shift;
2182   my (@pkgparts, %opt);
2183   if (ref($_[0]) eq 'HASH'){
2184     @pkgparts = @{$_[0]{pkgparts}};
2185     %opt      = %{$_[0]};
2186   }else{
2187     @pkgparts = @_;
2188   }
2189   grep { $_->suspend(%opt) }
2190     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2191       $self->unsuspended_pkgs;
2192 }
2193
2194 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2195
2196 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2197 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2198 instead of a list of pkgparts; the hashref has the following keys:
2199
2200 =over 4
2201
2202 =item pkgparts - listref of pkgparts
2203
2204 =item (other options are passed to the suspend method)
2205
2206 =back
2207
2208 Returns a list: an empty list on success or a list of errors.
2209
2210 =cut
2211
2212 sub suspend_unless_pkgpart {
2213   my $self = shift;
2214   my (@pkgparts, %opt);
2215   if (ref($_[0]) eq 'HASH'){
2216     @pkgparts = @{$_[0]{pkgparts}};
2217     %opt      = %{$_[0]};
2218   }else{
2219     @pkgparts = @_;
2220   }
2221   grep { $_->suspend(%opt) }
2222     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2223       $self->unsuspended_pkgs;
2224 }
2225
2226 =item cancel [ OPTION => VALUE ... ]
2227
2228 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2229
2230 Available options are:
2231
2232 =over 4
2233
2234 =item quiet - can be set true to supress email cancellation notices.
2235
2236 =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.
2237
2238 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2239
2240 =item nobill - can be set true to skip billing if it might otherwise be done.
2241
2242 =back
2243
2244 Always returns a list: an empty list on success or a list of errors.
2245
2246 =cut
2247
2248 # nb that dates are not specified as valid options to this method
2249
2250 sub cancel {
2251   my( $self, %opt ) = @_;
2252
2253   warn "$me cancel called on customer ". $self->custnum. " with options ".
2254        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2255     if $DEBUG;
2256
2257   return ( 'access denied' )
2258     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2259
2260   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2261
2262     #should try decryption (we might have the private key)
2263     # and if not maybe queue a job for the server that does?
2264     return ( "Can't (yet) ban encrypted credit cards" )
2265       if $self->is_encrypted($self->payinfo);
2266
2267     my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2268     my $error = $ban->insert;
2269     return ( $error ) if $error;
2270
2271   }
2272
2273   my @pkgs = $self->ncancelled_pkgs;
2274
2275   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2276     $opt{nobill} = 1;
2277     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2278     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2279       if $error;
2280   }
2281
2282   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2283        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2284     if $DEBUG;
2285
2286   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2287 }
2288
2289 sub _banned_pay_hashref {
2290   my $self = shift;
2291
2292   my %payby2ban = (
2293     'CARD' => 'CARD',
2294     'DCRD' => 'CARD',
2295     'CHEK' => 'CHEK',
2296     'DCHK' => 'CHEK'
2297   );
2298
2299   {
2300     'payby'   => $payby2ban{$self->payby},
2301     'payinfo' => $self->payinfo,
2302     #don't ever *search* on reason! #'reason'  =>
2303   };
2304 }
2305
2306 sub _new_banned_pay_hashref {
2307   my $self = shift;
2308   my $hr = $self->_banned_pay_hashref;
2309   $hr->{payinfo} = md5_base64($hr->{payinfo});
2310   $hr;
2311 }
2312
2313 =item notes
2314
2315 Returns all notes (see L<FS::cust_main_note>) for this customer.
2316
2317 =cut
2318
2319 sub notes {
2320   my($self,$orderby_classnum) = (shift,shift);
2321   my $orderby = "_DATE DESC";
2322   $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum;
2323   qsearch( 'cust_main_note',
2324            { 'custnum' => $self->custnum },
2325            '',
2326            "ORDER BY $orderby",
2327          );
2328 }
2329
2330 =item agent
2331
2332 Returns the agent (see L<FS::agent>) for this customer.
2333
2334 =item agent_name
2335
2336 Returns the agent name (see L<FS::agent>) for this customer.
2337
2338 =cut
2339
2340 sub agent_name {
2341   my $self = shift;
2342   $self->agent->agent;
2343 }
2344
2345 =item cust_tag
2346
2347 Returns any tags associated with this customer, as FS::cust_tag objects,
2348 or an empty list if there are no tags.
2349
2350 =item part_tag
2351
2352 Returns any tags associated with this customer, as FS::part_tag objects,
2353 or an empty list if there are no tags.
2354
2355 =cut
2356
2357 sub part_tag {
2358   my $self = shift;
2359   map $_->part_tag, $self->cust_tag;
2360 }
2361
2362
2363 =item cust_class
2364
2365 Returns the customer class, as an FS::cust_class object, or the empty string
2366 if there is no customer class.
2367
2368 =item categoryname
2369
2370 Returns the customer category name, or the empty string if there is no customer
2371 category.
2372
2373 =cut
2374
2375 sub categoryname {
2376   my $self = shift;
2377   my $cust_class = $self->cust_class;
2378   $cust_class
2379     ? $cust_class->categoryname
2380     : '';
2381 }
2382
2383 =item classname
2384
2385 Returns the customer class name, or the empty string if there is no customer
2386 class.
2387
2388 =cut
2389
2390 sub classname {
2391   my $self = shift;
2392   my $cust_class = $self->cust_class;
2393   $cust_class
2394     ? $cust_class->classname
2395     : '';
2396 }
2397
2398 =item BILLING METHODS
2399
2400 Documentation on billing methods has been moved to
2401 L<FS::cust_main::Billing>.
2402
2403 =item REALTIME BILLING METHODS
2404
2405 Documentation on realtime billing methods has been moved to
2406 L<FS::cust_main::Billing_Realtime>.
2407
2408 =item remove_cvv
2409
2410 Removes the I<paycvv> field from the database directly.
2411
2412 If there is an error, returns the error, otherwise returns false.
2413
2414 =cut
2415
2416 sub remove_cvv {
2417   my $self = shift;
2418   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2419     or return dbh->errstr;
2420   $sth->execute($self->custnum)
2421     or return $sth->errstr;
2422   $self->paycvv('');
2423   '';
2424 }
2425
2426 =item batch_card OPTION => VALUE...
2427
2428 Adds a payment for this invoice to the pending credit card batch (see
2429 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2430 runs the payment using a realtime gateway.
2431
2432 Options may include:
2433
2434 B<amount>: the amount to be paid; defaults to the customer's balance minus
2435 any payments in transit.
2436
2437 B<payby>: the payment method; defaults to cust_main.payby
2438
2439 B<realtime>: runs this as a realtime payment instead of adding it to a
2440 batch.  Deprecated.
2441
2442 B<invnum>: sets cust_pay_batch.invnum.
2443
2444 B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets
2445 the billing address for the payment; defaults to the customer's billing
2446 location.
2447
2448 B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
2449 date, and name; defaults to those fields in cust_main.
2450
2451 =cut
2452
2453 sub batch_card {
2454   my ($self, %options) = @_;
2455
2456   my $amount;
2457   if (exists($options{amount})) {
2458     $amount = $options{amount};
2459   }else{
2460     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2461   }
2462   return '' unless $amount > 0;
2463
2464   my $invnum = delete $options{invnum};
2465   my $payby = $options{payby} || $self->payby;  #still dubious
2466
2467   if ($options{'realtime'}) {
2468     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2469                                 $amount,
2470                                 %options,
2471                               );
2472   }
2473
2474   my $oldAutoCommit = $FS::UID::AutoCommit;
2475   local $FS::UID::AutoCommit = 0;
2476   my $dbh = dbh;
2477
2478   #this needs to handle mysql as well as Pg, like svc_acct.pm
2479   #(make it into a common function if folks need to do batching with mysql)
2480   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2481     or return "Cannot lock pay_batch: " . $dbh->errstr;
2482
2483   my %pay_batch = (
2484     'status' => 'O',
2485     'payby'  => FS::payby->payby2payment($payby),
2486   );
2487   $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2488
2489   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2490
2491   unless ( $pay_batch ) {
2492     $pay_batch = new FS::pay_batch \%pay_batch;
2493     my $error = $pay_batch->insert;
2494     if ( $error ) {
2495       $dbh->rollback if $oldAutoCommit;
2496       die "error creating new batch: $error\n";
2497     }
2498   }
2499
2500   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2501       'batchnum' => $pay_batch->batchnum,
2502       'custnum'  => $self->custnum,
2503   } );
2504
2505   foreach (qw( address1 address2 city state zip country latitude longitude
2506                payby payinfo paydate payname ))
2507   {
2508     $options{$_} = '' unless exists($options{$_});
2509   }
2510
2511   my $loc = $self->bill_location;
2512
2513   my $cust_pay_batch = new FS::cust_pay_batch ( {
2514     'batchnum' => $pay_batch->batchnum,
2515     'invnum'   => $invnum || 0,                    # is there a better value?
2516                                                    # this field should be
2517                                                    # removed...
2518                                                    # cust_bill_pay_batch now
2519     'custnum'  => $self->custnum,
2520     'last'     => $self->getfield('last'),
2521     'first'    => $self->getfield('first'),
2522     'address1' => $options{address1} || $loc->address1,
2523     'address2' => $options{address2} || $loc->address2,
2524     'city'     => $options{city}     || $loc->city,
2525     'state'    => $options{state}    || $loc->state,
2526     'zip'      => $options{zip}      || $loc->zip,
2527     'country'  => $options{country}  || $loc->country,
2528     'payby'    => $options{payby}    || $self->payby,
2529     'payinfo'  => $options{payinfo}  || $self->payinfo,
2530     'exp'      => $options{paydate}  || $self->paydate,
2531     'payname'  => $options{payname}  || $self->payname,
2532     'amount'   => $amount,                         # consolidating
2533   } );
2534
2535   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2536     if $old_cust_pay_batch;
2537
2538   my $error;
2539   if ($old_cust_pay_batch) {
2540     $error = $cust_pay_batch->replace($old_cust_pay_batch)
2541   } else {
2542     $error = $cust_pay_batch->insert;
2543   }
2544
2545   if ( $error ) {
2546     $dbh->rollback if $oldAutoCommit;
2547     die $error;
2548   }
2549
2550   my $unapplied =   $self->total_unapplied_credits
2551                   + $self->total_unapplied_payments
2552                   + $self->in_transit_payments;
2553   foreach my $cust_bill ($self->open_cust_bill) {
2554     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2555     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2556       'invnum' => $cust_bill->invnum,
2557       'paybatchnum' => $cust_pay_batch->paybatchnum,
2558       'amount' => $cust_bill->owed,
2559       '_date' => time,
2560     };
2561     if ($unapplied >= $cust_bill_pay_batch->amount){
2562       $unapplied -= $cust_bill_pay_batch->amount;
2563       next;
2564     }else{
2565       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2566                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
2567     }
2568     $error = $cust_bill_pay_batch->insert;
2569     if ( $error ) {
2570       $dbh->rollback if $oldAutoCommit;
2571       die $error;
2572     }
2573   }
2574
2575   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2576   '';
2577 }
2578
2579 =item total_owed
2580
2581 Returns the total owed for this customer on all invoices
2582 (see L<FS::cust_bill/owed>).
2583
2584 =cut
2585
2586 sub total_owed {
2587   my $self = shift;
2588   $self->total_owed_date(2145859200); #12/31/2037
2589 }
2590
2591 =item total_owed_date TIME
2592
2593 Returns the total owed for this customer on all invoices with date earlier than
2594 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2595 see L<Time::Local> and L<Date::Parse> for conversion functions.
2596
2597 =cut
2598
2599 sub total_owed_date {
2600   my $self = shift;
2601   my $time = shift;
2602
2603   my $custnum = $self->custnum;
2604
2605   my $owed_sql = FS::cust_bill->owed_sql;
2606
2607   my $sql = "
2608     SELECT SUM($owed_sql) FROM cust_bill
2609       WHERE custnum = $custnum
2610         AND _date <= $time
2611   ";
2612
2613   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2614
2615 }
2616
2617 =item total_owed_pkgnum PKGNUM
2618
2619 Returns the total owed on all invoices for this customer's specific package
2620 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2621
2622 =cut
2623
2624 sub total_owed_pkgnum {
2625   my( $self, $pkgnum ) = @_;
2626   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2627 }
2628
2629 =item total_owed_date_pkgnum TIME PKGNUM
2630
2631 Returns the total owed for this customer's specific package when using
2632 experimental package balances on all invoices with date earlier than
2633 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2634 see L<Time::Local> and L<Date::Parse> for conversion functions.
2635
2636 =cut
2637
2638 sub total_owed_date_pkgnum {
2639   my( $self, $time, $pkgnum ) = @_;
2640
2641   my $total_bill = 0;
2642   foreach my $cust_bill (
2643     grep { $_->_date <= $time }
2644       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2645   ) {
2646     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2647   }
2648   sprintf( "%.2f", $total_bill );
2649
2650 }
2651
2652 =item total_paid
2653
2654 Returns the total amount of all payments.
2655
2656 =cut
2657
2658 sub total_paid {
2659   my $self = shift;
2660   my $total = 0;
2661   $total += $_->paid foreach $self->cust_pay;
2662   sprintf( "%.2f", $total );
2663 }
2664
2665 =item total_unapplied_credits
2666
2667 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2668 customer.  See L<FS::cust_credit/credited>.
2669
2670 =item total_credited
2671
2672 Old name for total_unapplied_credits.  Don't use.
2673
2674 =cut
2675
2676 sub total_credited {
2677   #carp "total_credited deprecated, use total_unapplied_credits";
2678   shift->total_unapplied_credits(@_);
2679 }
2680
2681 sub total_unapplied_credits {
2682   my $self = shift;
2683
2684   my $custnum = $self->custnum;
2685
2686   my $unapplied_sql = FS::cust_credit->unapplied_sql;
2687
2688   my $sql = "
2689     SELECT SUM($unapplied_sql) FROM cust_credit
2690       WHERE custnum = $custnum
2691   ";
2692
2693   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2694
2695 }
2696
2697 =item total_unapplied_credits_pkgnum PKGNUM
2698
2699 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2700 customer.  See L<FS::cust_credit/credited>.
2701
2702 =cut
2703
2704 sub total_unapplied_credits_pkgnum {
2705   my( $self, $pkgnum ) = @_;
2706   my $total_credit = 0;
2707   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2708   sprintf( "%.2f", $total_credit );
2709 }
2710
2711
2712 =item total_unapplied_payments
2713
2714 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2715 See L<FS::cust_pay/unapplied>.
2716
2717 =cut
2718
2719 sub total_unapplied_payments {
2720   my $self = shift;
2721
2722   my $custnum = $self->custnum;
2723
2724   my $unapplied_sql = FS::cust_pay->unapplied_sql;
2725
2726   my $sql = "
2727     SELECT SUM($unapplied_sql) FROM cust_pay
2728       WHERE custnum = $custnum
2729   ";
2730
2731   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2732
2733 }
2734
2735 =item total_unapplied_payments_pkgnum PKGNUM
2736
2737 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2738 specific package when using experimental package balances.  See
2739 L<FS::cust_pay/unapplied>.
2740
2741 =cut
2742
2743 sub total_unapplied_payments_pkgnum {
2744   my( $self, $pkgnum ) = @_;
2745   my $total_unapplied = 0;
2746   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2747   sprintf( "%.2f", $total_unapplied );
2748 }
2749
2750
2751 =item total_unapplied_refunds
2752
2753 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2754 customer.  See L<FS::cust_refund/unapplied>.
2755
2756 =cut
2757
2758 sub total_unapplied_refunds {
2759   my $self = shift;
2760   my $custnum = $self->custnum;
2761
2762   my $unapplied_sql = FS::cust_refund->unapplied_sql;
2763
2764   my $sql = "
2765     SELECT SUM($unapplied_sql) FROM cust_refund
2766       WHERE custnum = $custnum
2767   ";
2768
2769   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2770
2771 }
2772
2773 =item balance
2774
2775 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2776 total_unapplied_credits minus total_unapplied_payments).
2777
2778 =cut
2779
2780 sub balance {
2781   my $self = shift;
2782   $self->balance_date_range;
2783 }
2784
2785 =item balance_date TIME
2786
2787 Returns the balance for this customer, only considering invoices with date
2788 earlier than TIME (total_owed_date minus total_credited minus
2789 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2790 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2791 functions.
2792
2793 =cut
2794
2795 sub balance_date {
2796   my $self = shift;
2797   $self->balance_date_range(shift);
2798 }
2799
2800 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2801
2802 Returns the balance for this customer, optionally considering invoices with
2803 date earlier than START_TIME, and not later than END_TIME
2804 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2805
2806 Times are specified as SQL fragments or numeric
2807 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
2808 L<Date::Parse> for conversion functions.  The empty string can be passed
2809 to disable that time constraint completely.
2810
2811 Available options are:
2812
2813 =over 4
2814
2815 =item unapplied_date
2816
2817 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)
2818
2819 =back
2820
2821 =cut
2822
2823 sub balance_date_range {
2824   my $self = shift;
2825   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2826             ') FROM cust_main WHERE custnum='. $self->custnum;
2827   sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2828 }
2829
2830 =item balance_pkgnum PKGNUM
2831
2832 Returns the balance for this customer's specific package when using
2833 experimental package balances (total_owed plus total_unrefunded, minus
2834 total_unapplied_credits minus total_unapplied_payments)
2835
2836 =cut
2837
2838 sub balance_pkgnum {
2839   my( $self, $pkgnum ) = @_;
2840
2841   sprintf( "%.2f",
2842       $self->total_owed_pkgnum($pkgnum)
2843 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2844 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
2845     - $self->total_unapplied_credits_pkgnum($pkgnum)
2846     - $self->total_unapplied_payments_pkgnum($pkgnum)
2847   );
2848 }
2849
2850 =item in_transit_payments
2851
2852 Returns the total of requests for payments for this customer pending in
2853 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
2854
2855 =cut
2856
2857 sub in_transit_payments {
2858   my $self = shift;
2859   my $in_transit_payments = 0;
2860   foreach my $pay_batch ( qsearch('pay_batch', {
2861     'status' => 'I',
2862   } ) ) {
2863     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2864       'batchnum' => $pay_batch->batchnum,
2865       'custnum' => $self->custnum,
2866     } ) ) {
2867       $in_transit_payments += $cust_pay_batch->amount;
2868     }
2869   }
2870   sprintf( "%.2f", $in_transit_payments );
2871 }
2872
2873 =item payment_info
2874
2875 Returns a hash of useful information for making a payment.
2876
2877 =over 4
2878
2879 =item balance
2880
2881 Current balance.
2882
2883 =item payby
2884
2885 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2886 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2887 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2888
2889 =back
2890
2891 For credit card transactions:
2892
2893 =over 4
2894
2895 =item card_type 1
2896
2897 =item payname
2898
2899 Exact name on card
2900
2901 =back
2902
2903 For electronic check transactions:
2904
2905 =over 4
2906
2907 =item stateid_state
2908
2909 =back
2910
2911 =cut
2912
2913 sub payment_info {
2914   my $self = shift;
2915
2916   my %return = ();
2917
2918   $return{balance} = $self->balance;
2919
2920   $return{payname} = $self->payname
2921                      || ( $self->first. ' '. $self->get('last') );
2922
2923   $return{$_} = $self->bill_location->$_
2924     for qw(address1 address2 city state zip);
2925
2926   $return{payby} = $self->payby;
2927   $return{stateid_state} = $self->stateid_state;
2928
2929   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2930     $return{card_type} = cardtype($self->payinfo);
2931     $return{payinfo} = $self->paymask;
2932
2933     @return{'month', 'year'} = $self->paydate_monthyear;
2934
2935   }
2936
2937   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2938     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2939     $return{payinfo1} = $payinfo1;
2940     $return{payinfo2} = $payinfo2;
2941     $return{paytype}  = $self->paytype;
2942     $return{paystate} = $self->paystate;
2943
2944   }
2945
2946   #doubleclick protection
2947   my $_date = time;
2948   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2949
2950   %return;
2951
2952 }
2953
2954 =item paydate_monthyear
2955
2956 Returns a two-element list consisting of the month and year of this customer's
2957 paydate (credit card expiration date for CARD customers)
2958
2959 =cut
2960
2961 sub paydate_monthyear {
2962   my $self = shift;
2963   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2964     ( $2, $1 );
2965   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2966     ( $1, $3 );
2967   } else {
2968     ('', '');
2969   }
2970 }
2971
2972 =item paydate_epoch
2973
2974 Returns the exact time in seconds corresponding to the payment method
2975 expiration date.  For CARD/DCRD customers this is the end of the month;
2976 for others (COMP is the only other payby that uses paydate) it's the start.
2977 Returns 0 if the paydate is empty or set to the far future.
2978
2979 =cut
2980
2981 sub paydate_epoch {
2982   my $self = shift;
2983   my ($month, $year) = $self->paydate_monthyear;
2984   return 0 if !$year or $year >= 2037;
2985   if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
2986     $month++;
2987     if ( $month == 13 ) {
2988       $month = 1;
2989       $year++;
2990     }
2991     return timelocal(0,0,0,1,$month-1,$year) - 1;
2992   }
2993   else {
2994     return timelocal(0,0,0,1,$month-1,$year);
2995   }
2996 }
2997
2998 =item paydate_epoch_sql
2999
3000 Class method.  Returns an SQL expression to obtain the payment expiration date
3001 as a number of seconds.
3002
3003 =cut
3004
3005 # Special expiration date behavior for non-CARD/DCRD customers has been
3006 # carefully preserved.  Do we really use that?
3007 sub paydate_epoch_sql {
3008   my $class = shift;
3009   my $table = shift || 'cust_main';
3010   my ($case1, $case2);
3011   if ( driver_name eq 'Pg' ) {
3012     $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
3013     $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
3014   }
3015   elsif ( lc(driver_name) eq 'mysql' ) {
3016     $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
3017     $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
3018   }
3019   else { return '' }
3020   return "CASE WHEN $table.payby IN('CARD','DCRD')
3021   THEN ($case1)
3022   ELSE ($case2)
3023   END"
3024 }
3025
3026 =item tax_exemption TAXNAME
3027
3028 =cut
3029
3030 sub tax_exemption {
3031   my( $self, $taxname ) = @_;
3032
3033   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3034                                      'taxname' => $taxname,
3035                                    },
3036           );
3037 }
3038
3039 =item cust_main_exemption
3040
3041 =item invoicing_list [ ARRAYREF ]
3042
3043 If an arguement is given, sets these email addresses as invoice recipients
3044 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3045 (except as warnings), so use check_invoicing_list first.
3046
3047 Returns a list of email addresses (with svcnum entries expanded).
3048
3049 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3050 check it without disturbing anything by passing nothing.
3051
3052 This interface may change in the future.
3053
3054 =cut
3055
3056 sub invoicing_list {
3057   my( $self, $arrayref ) = @_;
3058
3059   if ( $arrayref ) {
3060     my @cust_main_invoice;
3061     if ( $self->custnum ) {
3062       @cust_main_invoice =
3063         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3064     } else {
3065       @cust_main_invoice = ();
3066     }
3067     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3068       #warn $cust_main_invoice->destnum;
3069       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3070         #warn $cust_main_invoice->destnum;
3071         my $error = $cust_main_invoice->delete;
3072         warn $error if $error;
3073       }
3074     }
3075     if ( $self->custnum ) {
3076       @cust_main_invoice =
3077         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3078     } else {
3079       @cust_main_invoice = ();
3080     }
3081     my %seen = map { $_->address => 1 } @cust_main_invoice;
3082     foreach my $address ( @{$arrayref} ) {
3083       next if exists $seen{$address} && $seen{$address};
3084       $seen{$address} = 1;
3085       my $cust_main_invoice = new FS::cust_main_invoice ( {
3086         'custnum' => $self->custnum,
3087         'dest'    => $address,
3088       } );
3089       my $error = $cust_main_invoice->insert;
3090       warn $error if $error;
3091     }
3092   }
3093
3094   if ( $self->custnum ) {
3095     map { $_->address }
3096       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3097   } else {
3098     ();
3099   }
3100
3101 }
3102
3103 =item check_invoicing_list ARRAYREF
3104
3105 Checks these arguements as valid input for the invoicing_list method.  If there
3106 is an error, returns the error, otherwise returns false.
3107
3108 =cut
3109
3110 sub check_invoicing_list {
3111   my( $self, $arrayref ) = @_;
3112
3113   foreach my $address ( @$arrayref ) {
3114
3115     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3116       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3117     }
3118
3119     my $cust_main_invoice = new FS::cust_main_invoice ( {
3120       'custnum' => $self->custnum,
3121       'dest'    => $address,
3122     } );
3123     my $error = $self->custnum
3124                 ? $cust_main_invoice->check
3125                 : $cust_main_invoice->checkdest
3126     ;
3127     return $error if $error;
3128
3129   }
3130
3131   return "Email address required"
3132     if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3133     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3134
3135   '';
3136 }
3137
3138 =item set_default_invoicing_list
3139
3140 Sets the invoicing list to all accounts associated with this customer,
3141 overwriting any previous invoicing list.
3142
3143 =cut
3144
3145 sub set_default_invoicing_list {
3146   my $self = shift;
3147   $self->invoicing_list($self->all_emails);
3148 }
3149
3150 =item all_emails
3151
3152 Returns the email addresses of all accounts provisioned for this customer.
3153
3154 =cut
3155
3156 sub all_emails {
3157   my $self = shift;
3158   my %list;
3159   foreach my $cust_pkg ( $self->all_pkgs ) {
3160     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3161     my @svc_acct =
3162       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3163         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3164           @cust_svc;
3165     $list{$_}=1 foreach map { $_->email } @svc_acct;
3166   }
3167   keys %list;
3168 }
3169
3170 =item invoicing_list_addpost
3171
3172 Adds postal invoicing to this customer.  If this customer is already configured
3173 to receive postal invoices, does nothing.
3174
3175 =cut
3176
3177 sub invoicing_list_addpost {
3178   my $self = shift;
3179   return if grep { $_ eq 'POST' } $self->invoicing_list;
3180   my @invoicing_list = $self->invoicing_list;
3181   push @invoicing_list, 'POST';
3182   $self->invoicing_list(\@invoicing_list);
3183 }
3184
3185 =item invoicing_list_emailonly
3186
3187 Returns the list of email invoice recipients (invoicing_list without non-email
3188 destinations such as POST and FAX).
3189
3190 =cut
3191
3192 sub invoicing_list_emailonly {
3193   my $self = shift;
3194   warn "$me invoicing_list_emailonly called"
3195     if $DEBUG;
3196   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3197 }
3198
3199 =item invoicing_list_emailonly_scalar
3200
3201 Returns the list of email invoice recipients (invoicing_list without non-email
3202 destinations such as POST and FAX) as a comma-separated scalar.
3203
3204 =cut
3205
3206 sub invoicing_list_emailonly_scalar {
3207   my $self = shift;
3208   warn "$me invoicing_list_emailonly_scalar called"
3209     if $DEBUG;
3210   join(', ', $self->invoicing_list_emailonly);
3211 }
3212
3213 =item referral_custnum_cust_main
3214
3215 Returns the customer who referred this customer (or the empty string, if
3216 this customer was not referred).
3217
3218 Note the difference with referral_cust_main method: This method,
3219 referral_custnum_cust_main returns the single customer (if any) who referred
3220 this customer, while referral_cust_main returns an array of customers referred
3221 BY this customer.
3222
3223 =cut
3224
3225 sub referral_custnum_cust_main {
3226   my $self = shift;
3227   return '' unless $self->referral_custnum;
3228   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3229 }
3230
3231 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3232
3233 Returns an array of customers referred by this customer (referral_custnum set
3234 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3235 customers referred by customers referred by this customer and so on, inclusive.
3236 The default behavior is DEPTH 1 (no recursion).
3237
3238 Note the difference with referral_custnum_cust_main method: This method,
3239 referral_cust_main, returns an array of customers referred BY this customer,
3240 while referral_custnum_cust_main returns the single customer (if any) who
3241 referred this customer.
3242
3243 =cut
3244
3245 sub referral_cust_main {
3246   my $self = shift;
3247   my $depth = @_ ? shift : 1;
3248   my $exclude = @_ ? shift : {};
3249
3250   my @cust_main =
3251     map { $exclude->{$_->custnum}++; $_; }
3252       grep { ! $exclude->{ $_->custnum } }
3253         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3254
3255   if ( $depth > 1 ) {
3256     push @cust_main,
3257       map { $_->referral_cust_main($depth-1, $exclude) }
3258         @cust_main;
3259   }
3260
3261   @cust_main;
3262 }
3263
3264 =item referral_cust_main_ncancelled
3265
3266 Same as referral_cust_main, except only returns customers with uncancelled
3267 packages.
3268
3269 =cut
3270
3271 sub referral_cust_main_ncancelled {
3272   my $self = shift;
3273   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3274 }
3275
3276 =item referral_cust_pkg [ DEPTH ]
3277
3278 Like referral_cust_main, except returns a flat list of all unsuspended (and
3279 uncancelled) packages for each customer.  The number of items in this list may
3280 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3281
3282 =cut
3283
3284 sub referral_cust_pkg {
3285   my $self = shift;
3286   my $depth = @_ ? shift : 1;
3287
3288   map { $_->unsuspended_pkgs }
3289     grep { $_->unsuspended_pkgs }
3290       $self->referral_cust_main($depth);
3291 }
3292
3293 =item referring_cust_main
3294
3295 Returns the single cust_main record for the customer who referred this customer
3296 (referral_custnum), or false.
3297
3298 =cut
3299
3300 sub referring_cust_main {
3301   my $self = shift;
3302   return '' unless $self->referral_custnum;
3303   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3304 }
3305
3306 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3307
3308 Applies a credit to this customer.  If there is an error, returns the error,
3309 otherwise returns false.
3310
3311 REASON can be a text string, an FS::reason object, or a scalar reference to
3312 a reasonnum.  If a text string, it will be automatically inserted as a new
3313 reason, and a 'reason_type' option must be passed to indicate the
3314 FS::reason_type for the new reason.
3315
3316 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3317 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3318 I<commission_pkgnum>.
3319
3320 Any other options are passed to FS::cust_credit::insert.
3321
3322 =cut
3323
3324 sub credit {
3325   my( $self, $amount, $reason, %options ) = @_;
3326
3327   my $cust_credit = new FS::cust_credit {
3328     'custnum' => $self->custnum,
3329     'amount'  => $amount,
3330   };
3331
3332   if ( ref($reason) ) {
3333
3334     if ( ref($reason) eq 'SCALAR' ) {
3335       $cust_credit->reasonnum( $$reason );
3336     } else {
3337       $cust_credit->reasonnum( $reason->reasonnum );
3338     }
3339
3340   } else {
3341     $cust_credit->set('reason', $reason)
3342   }
3343
3344   $cust_credit->$_( delete $options{$_} )
3345     foreach grep exists($options{$_}),
3346               qw( addlinfo eventnum ),
3347               map "commission_$_", qw( agentnum salesnum pkgnum );
3348
3349   $cust_credit->insert(%options);
3350
3351 }
3352
3353 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3354
3355 Creates a one-time charge for this customer.  If there is an error, returns
3356 the error, otherwise returns false.
3357
3358 New-style, with a hashref of options:
3359
3360   my $error = $cust_main->charge(
3361                                   {
3362                                     'amount'     => 54.32,
3363                                     'quantity'   => 1,
3364                                     'start_date' => str2time('7/4/2009'),
3365                                     'pkg'        => 'Description',
3366                                     'comment'    => 'Comment',
3367                                     'additional' => [], #extra invoice detail
3368                                     'classnum'   => 1,  #pkg_class
3369
3370                                     'setuptax'   => '', # or 'Y' for tax exempt
3371
3372                                     'locationnum'=> 1234, # optional
3373
3374                                     #internal taxation
3375                                     'taxclass'   => 'Tax class',
3376
3377                                     #vendor taxation
3378                                     'taxproduct' => 2,  #part_pkg_taxproduct
3379                                     'override'   => {}, #XXX describe
3380
3381                                     #will be filled in with the new object
3382                                     'cust_pkg_ref' => \$cust_pkg,
3383
3384                                     #generate an invoice immediately
3385                                     'bill_now' => 0,
3386                                     'invoice_terms' => '', #with these terms
3387                                   }
3388                                 );
3389
3390 Old-style:
3391
3392   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3393
3394 =cut
3395
3396 sub charge {
3397   my $self = shift;
3398   my ( $amount, $quantity, $start_date, $classnum );
3399   my ( $pkg, $comment, $additional );
3400   my ( $setuptax, $taxclass );   #internal taxes
3401   my ( $taxproduct, $override ); #vendor (CCH) taxes
3402   my $no_auto = '';
3403   my $cust_pkg_ref = '';
3404   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3405   my $locationnum;
3406   if ( ref( $_[0] ) ) {
3407     $amount     = $_[0]->{amount};
3408     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3409     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3410     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3411     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3412     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3413                                            : '$'. sprintf("%.2f",$amount);
3414     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3415     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3416     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3417     $additional = $_[0]->{additional} || [];
3418     $taxproduct = $_[0]->{taxproductnum};
3419     $override   = { '' => $_[0]->{tax_override} };
3420     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3421     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3422     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3423     $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3424   } else {
3425     $amount     = shift;
3426     $quantity   = 1;
3427     $start_date = '';
3428     $pkg        = @_ ? shift : 'One-time charge';
3429     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3430     $setuptax   = '';
3431     $taxclass   = @_ ? shift : '';
3432     $additional = [];
3433   }
3434
3435   local $SIG{HUP} = 'IGNORE';
3436   local $SIG{INT} = 'IGNORE';
3437   local $SIG{QUIT} = 'IGNORE';
3438   local $SIG{TERM} = 'IGNORE';
3439   local $SIG{TSTP} = 'IGNORE';
3440   local $SIG{PIPE} = 'IGNORE';
3441
3442   my $oldAutoCommit = $FS::UID::AutoCommit;
3443   local $FS::UID::AutoCommit = 0;
3444   my $dbh = dbh;
3445
3446   my $part_pkg = new FS::part_pkg ( {
3447     'pkg'           => $pkg,
3448     'comment'       => $comment,
3449     'plan'          => 'flat',
3450     'freq'          => 0,
3451     'disabled'      => 'Y',
3452     'classnum'      => ( $classnum ? $classnum : '' ),
3453     'setuptax'      => $setuptax,
3454     'taxclass'      => $taxclass,
3455     'taxproductnum' => $taxproduct,
3456   } );
3457
3458   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3459                         ( 0 .. @$additional - 1 )
3460                   ),
3461                   'additional_count' => scalar(@$additional),
3462                   'setup_fee' => $amount,
3463                 );
3464
3465   my $error = $part_pkg->insert( options       => \%options,
3466                                  tax_overrides => $override,
3467                                );
3468   if ( $error ) {
3469     $dbh->rollback if $oldAutoCommit;
3470     return $error;
3471   }
3472
3473   my $pkgpart = $part_pkg->pkgpart;
3474   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3475   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3476     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3477     $error = $type_pkgs->insert;
3478     if ( $error ) {
3479       $dbh->rollback if $oldAutoCommit;
3480       return $error;
3481     }
3482   }
3483
3484   my $cust_pkg = new FS::cust_pkg ( {
3485     'custnum'    => $self->custnum,
3486     'pkgpart'    => $pkgpart,
3487     'quantity'   => $quantity,
3488     'start_date' => $start_date,
3489     'no_auto'    => $no_auto,
3490     'locationnum'=> $locationnum,
3491   } );
3492
3493   $error = $cust_pkg->insert;
3494   if ( $error ) {
3495     $dbh->rollback if $oldAutoCommit;
3496     return $error;
3497   } elsif ( $cust_pkg_ref ) {
3498     ${$cust_pkg_ref} = $cust_pkg;
3499   }
3500
3501   if ( $bill_now ) {
3502     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3503                              'pkg_list'      => [ $cust_pkg ],
3504                            );
3505     if ( $error ) {
3506       $dbh->rollback if $oldAutoCommit;
3507       return $error;
3508     }
3509   }
3510
3511   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3512   return '';
3513
3514 }
3515
3516 #=item charge_postal_fee
3517 #
3518 #Applies a one time charge this customer.  If there is an error,
3519 #returns the error, returns the cust_pkg charge object or false
3520 #if there was no charge.
3521 #
3522 #=cut
3523 #
3524 # This should be a customer event.  For that to work requires that bill
3525 # also be a customer event.
3526
3527 sub charge_postal_fee {
3528   my $self = shift;
3529
3530   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3531   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3532
3533   my $cust_pkg = new FS::cust_pkg ( {
3534     'custnum'  => $self->custnum,
3535     'pkgpart'  => $pkgpart,
3536     'quantity' => 1,
3537   } );
3538
3539   my $error = $cust_pkg->insert;
3540   $error ? $error : $cust_pkg;
3541 }
3542
3543 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3544
3545 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3546
3547 Optionally, a list or hashref of additional arguments to the qsearch call can
3548 be passed.
3549
3550 =cut
3551
3552 sub cust_bill {
3553   my $self = shift;
3554   my $opt = ref($_[0]) ? shift : { @_ };
3555
3556   #return $self->num_cust_bill unless wantarray || keys %$opt;
3557
3558   $opt->{'table'} = 'cust_bill';
3559   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3560   $opt->{'hashref'}{'custnum'} = $self->custnum;
3561   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3562
3563   map { $_ } #behavior of sort undefined in scalar context
3564     sort { $a->_date <=> $b->_date }
3565       qsearch($opt);
3566 }
3567
3568 =item open_cust_bill
3569
3570 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3571 customer.
3572
3573 =cut
3574
3575 sub open_cust_bill {
3576   my $self = shift;
3577
3578   $self->cust_bill(
3579     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3580     #@_
3581   );
3582
3583 }
3584
3585 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3586
3587 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3588
3589 =cut
3590
3591 sub legacy_cust_bill {
3592   my $self = shift;
3593
3594   #return $self->num_legacy_cust_bill unless wantarray;
3595
3596   map { $_ } #behavior of sort undefined in scalar context
3597     sort { $a->_date <=> $b->_date }
3598       qsearch({ 'table'    => 'legacy_cust_bill',
3599                 'hashref'  => { 'custnum' => $self->custnum, },
3600                 'order_by' => 'ORDER BY _date ASC',
3601              });
3602 }
3603
3604 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3605
3606 Returns all the statements (see L<FS::cust_statement>) for this customer.
3607
3608 Optionally, a list or hashref of additional arguments to the qsearch call can
3609 be passed.
3610
3611 =cut
3612
3613 =item cust_bill_void
3614
3615 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3616
3617 =cut
3618
3619 sub cust_bill_void {
3620   my $self = shift;
3621
3622   map { $_ } #return $self->num_cust_bill_void unless wantarray;
3623   sort { $a->_date <=> $b->_date }
3624     qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3625 }
3626
3627 sub cust_statement {
3628   my $self = shift;
3629   my $opt = ref($_[0]) ? shift : { @_ };
3630
3631   #return $self->num_cust_statement unless wantarray || keys %$opt;
3632
3633   $opt->{'table'} = 'cust_statement';
3634   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3635   $opt->{'hashref'}{'custnum'} = $self->custnum;
3636   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3637
3638   map { $_ } #behavior of sort undefined in scalar context
3639     sort { $a->_date <=> $b->_date }
3640       qsearch($opt);
3641 }
3642
3643 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3644
3645 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3646
3647 Optionally, a list or hashref of additional arguments to the qsearch call can
3648 be passed following the SVCDB.
3649
3650 =cut
3651
3652 sub svc_x {
3653   my $self = shift;
3654   my $svcdb = shift;
3655   if ( ! $svcdb =~ /^svc_\w+$/ ) {
3656     warn "$me svc_x requires a svcdb";
3657     return;
3658   }
3659   my $opt = ref($_[0]) ? shift : { @_ };
3660
3661   $opt->{'table'} = $svcdb;
3662   $opt->{'addl_from'} =
3663     'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3664     ($opt->{'addl_from'} || '');
3665
3666   my $custnum = $self->custnum;
3667   $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3668   my $where = "cust_pkg.custnum = $custnum";
3669
3670   my $extra_sql = $opt->{'extra_sql'} || '';
3671   if ( keys %{ $opt->{'hashref'} } ) {
3672     $extra_sql = " AND $where $extra_sql";
3673   }
3674   else {
3675     if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3676       $extra_sql = "WHERE $where AND $1";
3677     }
3678     else {
3679       $extra_sql = "WHERE $where $extra_sql";
3680     }
3681   }
3682   $opt->{'extra_sql'} = $extra_sql;
3683
3684   qsearch($opt);
3685 }
3686
3687 # required for use as an eventtable;
3688 sub svc_acct {
3689   my $self = shift;
3690   $self->svc_x('svc_acct', @_);
3691 }
3692
3693 =item cust_credit
3694
3695 Returns all the credits (see L<FS::cust_credit>) for this customer.
3696
3697 =cut
3698
3699 sub cust_credit {
3700   my $self = shift;
3701   map { $_ } #return $self->num_cust_credit unless wantarray;
3702   sort { $a->_date <=> $b->_date }
3703     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3704 }
3705
3706 =item cust_credit_pkgnum
3707
3708 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3709 package when using experimental package balances.
3710
3711 =cut
3712
3713 sub cust_credit_pkgnum {
3714   my( $self, $pkgnum ) = @_;
3715   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3716   sort { $a->_date <=> $b->_date }
3717     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3718                               'pkgnum'  => $pkgnum,
3719                             }
3720     );
3721 }
3722
3723 =item cust_credit_void
3724
3725 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3726
3727 =cut
3728
3729 sub cust_credit_void {
3730   my $self = shift;
3731   map { $_ }
3732   sort { $a->_date <=> $b->_date }
3733     qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3734 }
3735
3736 =item cust_pay
3737
3738 Returns all the payments (see L<FS::cust_pay>) for this customer.
3739
3740 =cut
3741
3742 sub cust_pay {
3743   my $self = shift;
3744   return $self->num_cust_pay unless wantarray;
3745   sort { $a->_date <=> $b->_date }
3746     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3747 }
3748
3749 =item num_cust_pay
3750
3751 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3752 called automatically when the cust_pay method is used in a scalar context.
3753
3754 =cut
3755
3756 sub num_cust_pay {
3757   my $self = shift;
3758   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3759   my $sth = dbh->prepare($sql) or die dbh->errstr;
3760   $sth->execute($self->custnum) or die $sth->errstr;
3761   $sth->fetchrow_arrayref->[0];
3762 }
3763
3764 =item cust_pay_pkgnum
3765
3766 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3767 package when using experimental package balances.
3768
3769 =cut
3770
3771 sub cust_pay_pkgnum {
3772   my( $self, $pkgnum ) = @_;
3773   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3774   sort { $a->_date <=> $b->_date }
3775     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3776                            'pkgnum'  => $pkgnum,
3777                          }
3778     );
3779 }
3780
3781 =item cust_pay_void
3782
3783 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3784
3785 =cut
3786
3787 sub cust_pay_void {
3788   my $self = shift;
3789   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3790   sort { $a->_date <=> $b->_date }
3791     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3792 }
3793
3794 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3795
3796 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
3797
3798 Optionally, a list or hashref of additional arguments to the qsearch call can
3799 be passed.
3800
3801 =cut
3802
3803 sub cust_pay_batch {
3804   my $self = shift;
3805   my $opt = ref($_[0]) ? shift : { @_ };
3806
3807   #return $self->num_cust_statement unless wantarray || keys %$opt;
3808
3809   $opt->{'table'} = 'cust_pay_batch';
3810   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3811   $opt->{'hashref'}{'custnum'} = $self->custnum;
3812   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3813
3814   map { $_ } #behavior of sort undefined in scalar context
3815     sort { $a->paybatchnum <=> $b->paybatchnum }
3816       qsearch($opt);
3817 }
3818
3819 =item cust_pay_pending
3820
3821 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3822 (without status "done").
3823
3824 =cut
3825
3826 sub cust_pay_pending {
3827   my $self = shift;
3828   return $self->num_cust_pay_pending unless wantarray;
3829   sort { $a->_date <=> $b->_date }
3830     qsearch( 'cust_pay_pending', {
3831                                    'custnum' => $self->custnum,
3832                                    'status'  => { op=>'!=', value=>'done' },
3833                                  },
3834            );
3835 }
3836
3837 =item cust_pay_pending_attempt
3838
3839 Returns all payment attempts / declined payments for this customer, as pending
3840 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3841 a corresponding payment (see L<FS::cust_pay>).
3842
3843 =cut
3844
3845 sub cust_pay_pending_attempt {
3846   my $self = shift;
3847   return $self->num_cust_pay_pending_attempt unless wantarray;
3848   sort { $a->_date <=> $b->_date }
3849     qsearch( 'cust_pay_pending', {
3850                                    'custnum' => $self->custnum,
3851                                    'status'  => 'done',
3852                                    'paynum'  => '',
3853                                  },
3854            );
3855 }
3856
3857 =item num_cust_pay_pending
3858
3859 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3860 customer (without status "done").  Also called automatically when the
3861 cust_pay_pending method is used in a scalar context.
3862
3863 =cut
3864
3865 sub num_cust_pay_pending {
3866   my $self = shift;
3867   $self->scalar_sql(
3868     " SELECT COUNT(*) FROM cust_pay_pending ".
3869       " WHERE custnum = ? AND status != 'done' ",
3870     $self->custnum
3871   );
3872 }
3873
3874 =item num_cust_pay_pending_attempt
3875
3876 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3877 customer, with status "done" but without a corresp.  Also called automatically when the
3878 cust_pay_pending method is used in a scalar context.
3879
3880 =cut
3881
3882 sub num_cust_pay_pending_attempt {
3883   my $self = shift;
3884   $self->scalar_sql(
3885     " SELECT COUNT(*) FROM cust_pay_pending ".
3886       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3887     $self->custnum
3888   );
3889 }
3890
3891 =item cust_refund
3892
3893 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3894
3895 =cut
3896
3897 sub cust_refund {
3898   my $self = shift;
3899   map { $_ } #return $self->num_cust_refund unless wantarray;
3900   sort { $a->_date <=> $b->_date }
3901     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3902 }
3903
3904 =item display_custnum
3905
3906 Returns the displayed customer number for this customer: agent_custid if
3907 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3908
3909 =cut
3910
3911 sub display_custnum {
3912   my $self = shift;
3913
3914   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3915   if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3916     if ( $special eq 'CoStAg' ) {
3917       $prefix = uc( join('',
3918         $self->country,
3919         ($self->state =~ /^(..)/),
3920         $prefix || ($self->agent->agent =~ /^(..)/)
3921       ) );
3922     }
3923     elsif ( $special eq 'CoStCl' ) {
3924       $prefix = uc( join('',
3925         $self->country,
3926         ($self->state =~ /^(..)/),
3927         ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3928       ) );
3929     }
3930     # add any others here if needed
3931   }
3932
3933   my $length = $conf->config('cust_main-custnum-display_length');
3934   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3935     return $self->agent_custid;
3936   } elsif ( $prefix ) {
3937     $length = 8 if !defined($length);
3938     return $prefix .
3939            sprintf('%0'.$length.'d', $self->custnum)
3940   } elsif ( $length ) {
3941     return sprintf('%0'.$length.'d', $self->custnum);
3942   } else {
3943     return $self->custnum;
3944   }
3945 }
3946
3947 =item name
3948
3949 Returns a name string for this customer, either "Company (Last, First)" or
3950 "Last, First".
3951
3952 =cut
3953
3954 sub name {
3955   my $self = shift;
3956   my $name = $self->contact;
3957   $name = $self->company. " ($name)" if $self->company;
3958   $name;
3959 }
3960
3961 =item service_contact
3962
3963 Returns the L<FS::contact> object for this customer that has the 'Service'
3964 contact class, or undef if there is no such contact.  Deprecated; don't use
3965 this in new code.
3966
3967 =cut
3968
3969 sub service_contact {
3970   my $self = shift;
3971   if ( !exists($self->{service_contact}) ) {
3972     my $classnum = $self->scalar_sql(
3973       'SELECT classnum FROM contact_class WHERE classname = \'Service\''
3974     ) || 0; #if it's zero, qsearchs will return nothing
3975     $self->{service_contact} = qsearchs('contact', {
3976         'classnum' => $classnum, 'custnum' => $self->custnum
3977       }) || undef;
3978   }
3979   $self->{service_contact};
3980 }
3981
3982 =item ship_name
3983
3984 Returns a name string for this (service/shipping) contact, either
3985 "Company (Last, First)" or "Last, First".
3986
3987 =cut
3988
3989 sub ship_name {
3990   my $self = shift;
3991
3992   my $name = $self->ship_contact;
3993   $name = $self->company. " ($name)" if $self->company;
3994   $name;
3995 }
3996
3997 =item name_short
3998
3999 Returns a name string for this customer, either "Company" or "First Last".
4000
4001 =cut
4002
4003 sub name_short {
4004   my $self = shift;
4005   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4006 }
4007
4008 =item ship_name_short
4009
4010 Returns a name string for this (service/shipping) contact, either "Company"
4011 or "First Last".
4012
4013 =cut
4014
4015 sub ship_name_short {
4016   my $self = shift;
4017   $self->service_contact
4018     ? $self->ship_contact_firstlast
4019     : $self->name_short
4020 }
4021
4022 =item contact
4023
4024 Returns this customer's full (billing) contact name only, "Last, First"
4025
4026 =cut
4027
4028 sub contact {
4029   my $self = shift;
4030   $self->get('last'). ', '. $self->first;
4031 }
4032
4033 =item ship_contact
4034
4035 Returns this customer's full (shipping) contact name only, "Last, First"
4036
4037 =cut
4038
4039 sub ship_contact {
4040   my $self = shift;
4041   my $contact = $self->service_contact || $self;
4042   $contact->get('last') . ', ' . $contact->get('first');
4043 }
4044
4045 =item contact_firstlast
4046
4047 Returns this customers full (billing) contact name only, "First Last".
4048
4049 =cut
4050
4051 sub contact_firstlast {
4052   my $self = shift;
4053   $self->first. ' '. $self->get('last');
4054 }
4055
4056 =item ship_contact_firstlast
4057
4058 Returns this customer's full (shipping) contact name only, "First Last".
4059
4060 =cut
4061
4062 sub ship_contact_firstlast {
4063   my $self = shift;
4064   my $contact = $self->service_contact || $self;
4065   $contact->get('first') . ' '. $contact->get('last');
4066 }
4067
4068 #XXX this doesn't work in 3.x+
4069 #=item country_full
4070 #
4071 #Returns this customer's full country name
4072 #
4073 #=cut
4074 #
4075 #sub country_full {
4076 #  my $self = shift;
4077 #  code2country($self->country);
4078 #}
4079
4080 sub bill_country_full {
4081   my $self = shift;
4082   code2country($self->bill_location->country);
4083 }
4084
4085 sub ship_country_full {
4086   my $self = shift;
4087   code2country($self->ship_location->country);
4088 }
4089
4090 =item county_state_county [ PREFIX ]
4091
4092 Returns a string consisting of just the county, state and country.
4093
4094 =cut
4095
4096 sub county_state_country {
4097   my $self = shift;
4098   my $locationnum;
4099   if ( @_ && $_[0] && $self->has_ship_address ) {
4100     $locationnum = $self->ship_locationnum;
4101   } else {
4102     $locationnum = $self->bill_locationnum;
4103   }
4104   my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4105   $cust_location->county_state_country;
4106 }
4107
4108 =item geocode DATA_VENDOR
4109
4110 Returns a value for the customer location as encoded by DATA_VENDOR.
4111 Currently this only makes sense for "CCH" as DATA_VENDOR.
4112
4113 =cut
4114
4115 =item cust_status
4116
4117 =item status
4118
4119 Returns a status string for this customer, currently:
4120
4121 =over 4
4122
4123 =item prospect - No packages have ever been ordered
4124
4125 =item ordered - Recurring packages all are new (not yet billed).
4126
4127 =item active - One or more recurring packages is active
4128
4129 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4130
4131 =item suspended - All non-cancelled recurring packages are suspended
4132
4133 =item cancelled - All recurring packages are cancelled
4134
4135 =back
4136
4137 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4138 cust_main-status_module configuration option.
4139
4140 =cut
4141
4142 sub status { shift->cust_status(@_); }
4143
4144 sub cust_status {
4145   my $self = shift;
4146   for my $status ( FS::cust_main->statuses() ) {
4147     my $method = $status.'_sql';
4148     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4149     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4150     $sth->execute( ($self->custnum) x $numnum )
4151       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4152     return $status if $sth->fetchrow_arrayref->[0];
4153   }
4154 }
4155
4156 =item ucfirst_cust_status
4157
4158 =item ucfirst_status
4159
4160 Returns the status with the first character capitalized.
4161
4162 =cut
4163
4164 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4165
4166 sub ucfirst_cust_status {
4167   my $self = shift;
4168   ucfirst($self->cust_status);
4169 }
4170
4171 =item statuscolor
4172
4173 Returns a hex triplet color string for this customer's status.
4174
4175 =cut
4176
4177 sub statuscolor { shift->cust_statuscolor(@_); }
4178
4179 sub cust_statuscolor {
4180   my $self = shift;
4181   __PACKAGE__->statuscolors->{$self->cust_status};
4182 }
4183
4184 =item tickets [ STATUS ]
4185
4186 Returns an array of hashes representing the customer's RT tickets.
4187
4188 An optional status (or arrayref or hashref of statuses) may be specified.
4189
4190 =cut
4191
4192 sub tickets {
4193   my $self = shift;
4194   my $status = ( @_ && $_[0] ) ? shift : '';
4195
4196   my $num = $conf->config('cust_main-max_tickets') || 10;
4197   my @tickets = ();
4198
4199   if ( $conf->config('ticket_system') ) {
4200     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4201
4202       @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4203                                                         $num,
4204                                                         undef,
4205                                                         $status,
4206                                                       )
4207                   };
4208
4209     } else {
4210
4211       foreach my $priority (
4212         $conf->config('ticket_system-custom_priority_field-values'), ''
4213       ) {
4214         last if scalar(@tickets) >= $num;
4215         push @tickets,
4216           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4217                                                  $num - scalar(@tickets),
4218                                                  $priority,
4219                                                  $status,
4220                                                )
4221            };
4222       }
4223     }
4224   }
4225   (@tickets);
4226 }
4227
4228 # Return services representing svc_accts in customer support packages
4229 sub support_services {
4230   my $self = shift;
4231   my %packages = map { $_ => 1 } $conf->config('support_packages');
4232
4233   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4234     grep { $_->part_svc->svcdb eq 'svc_acct' }
4235     map { $_->cust_svc }
4236     grep { exists $packages{ $_->pkgpart } }
4237     $self->ncancelled_pkgs;
4238
4239 }
4240
4241 # Return a list of latitude/longitude for one of the services (if any)
4242 sub service_coordinates {
4243   my $self = shift;
4244
4245   my @svc_X =
4246     grep { $_->latitude && $_->longitude }
4247     map { $_->svc_x }
4248     map { $_->cust_svc }
4249     $self->ncancelled_pkgs;
4250
4251   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4252 }
4253
4254 =item masked FIELD
4255
4256 Returns a masked version of the named field
4257
4258 =cut
4259
4260 sub masked {
4261 my ($self,$field) = @_;
4262
4263 # Show last four
4264
4265 'x'x(length($self->getfield($field))-4).
4266   substr($self->getfield($field), (length($self->getfield($field))-4));
4267
4268 }
4269
4270 =back
4271
4272 =head1 CLASS METHODS
4273
4274 =over 4
4275
4276 =item statuses
4277
4278 Class method that returns the list of possible status strings for customers
4279 (see L<the status method|/status>).  For example:
4280
4281   @statuses = FS::cust_main->statuses();
4282
4283 =cut
4284
4285 sub statuses {
4286   my $self = shift;
4287   keys %{ $self->statuscolors };
4288 }
4289
4290 =item cust_status_sql
4291
4292 Returns an SQL fragment to determine the status of a cust_main record, as a
4293 string.
4294
4295 =cut
4296
4297 sub cust_status_sql {
4298   my $sql = 'CASE';
4299   for my $status ( FS::cust_main->statuses() ) {
4300     my $method = $status.'_sql';
4301     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4302   }
4303   $sql .= ' END';
4304   return $sql;
4305 }
4306
4307
4308 =item prospect_sql
4309
4310 Returns an SQL expression identifying prospective cust_main records (customers
4311 with no packages ever ordered)
4312
4313 =cut
4314
4315 use vars qw($select_count_pkgs);
4316 $select_count_pkgs =
4317   "SELECT COUNT(*) FROM cust_pkg
4318     WHERE cust_pkg.custnum = cust_main.custnum";
4319
4320 sub select_count_pkgs_sql {
4321   $select_count_pkgs;
4322 }
4323
4324 sub prospect_sql {
4325   " 0 = ( $select_count_pkgs ) ";
4326 }
4327
4328 =item ordered_sql
4329
4330 Returns an SQL expression identifying ordered cust_main records (customers with
4331 no active packages, but recurring packages not yet setup or one time charges
4332 not yet billed).
4333
4334 =cut
4335
4336 sub ordered_sql {
4337   FS::cust_main->none_active_sql.
4338   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4339 }
4340
4341 =item active_sql
4342
4343 Returns an SQL expression identifying active cust_main records (customers with
4344 active recurring packages).
4345
4346 =cut
4347
4348 sub active_sql {
4349   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4350 }
4351
4352 =item none_active_sql
4353
4354 Returns an SQL expression identifying cust_main records with no active
4355 recurring packages.  This includes customers of status prospect, ordered,
4356 inactive, and suspended.
4357
4358 =cut
4359
4360 sub none_active_sql {
4361   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4362 }
4363
4364 =item inactive_sql
4365
4366 Returns an SQL expression identifying inactive cust_main records (customers with
4367 no active recurring packages, but otherwise unsuspended/uncancelled).
4368
4369 =cut
4370
4371 sub inactive_sql {
4372   FS::cust_main->none_active_sql.
4373   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4374 }
4375
4376 =item susp_sql
4377 =item suspended_sql
4378
4379 Returns an SQL expression identifying suspended cust_main records.
4380
4381 =cut
4382
4383
4384 sub suspended_sql { susp_sql(@_); }
4385 sub susp_sql {
4386   FS::cust_main->none_active_sql.
4387   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4388 }
4389
4390 =item cancel_sql
4391 =item cancelled_sql
4392
4393 Returns an SQL expression identifying cancelled cust_main records.
4394
4395 =cut
4396
4397 sub cancel_sql { shift->cancelled_sql(@_); }
4398
4399 =item uncancel_sql
4400 =item uncancelled_sql
4401
4402 Returns an SQL expression identifying un-cancelled cust_main records.
4403
4404 =cut
4405
4406 sub uncancelled_sql { uncancel_sql(@_); }
4407 sub uncancel_sql { "
4408   ( 0 < ( $select_count_pkgs
4409                    AND ( cust_pkg.cancel IS NULL
4410                          OR cust_pkg.cancel = 0
4411                        )
4412         )
4413     OR 0 = ( $select_count_pkgs )
4414   )
4415 "; }
4416
4417 =item balance_sql
4418
4419 Returns an SQL fragment to retreive the balance.
4420
4421 =cut
4422
4423 sub balance_sql { "
4424     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4425         WHERE cust_bill.custnum   = cust_main.custnum     )
4426   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4427         WHERE cust_pay.custnum    = cust_main.custnum     )
4428   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4429         WHERE cust_credit.custnum = cust_main.custnum     )
4430   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4431         WHERE cust_refund.custnum = cust_main.custnum     )
4432 "; }
4433
4434 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4435
4436 Returns an SQL fragment to retreive the balance for this customer, optionally
4437 considering invoices with date earlier than START_TIME, and not
4438 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4439 total_unapplied_payments).
4440
4441 Times are specified as SQL fragments or numeric
4442 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4443 L<Date::Parse> for conversion functions.  The empty string can be passed
4444 to disable that time constraint completely.
4445
4446 Available options are:
4447
4448 =over 4
4449
4450 =item unapplied_date
4451
4452 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)
4453
4454 =item total
4455
4456 (unused.  obsolete?)
4457 set to true to remove all customer comparison clauses, for totals
4458
4459 =item where
4460
4461 (unused.  obsolete?)
4462 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4463
4464 =item join
4465
4466 (unused.  obsolete?)
4467 JOIN clause (typically used with the total option)
4468
4469 =item cutoff
4470
4471 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4472 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4473 range for invoices and I<unapplied> payments, credits, and refunds.
4474
4475 =back
4476
4477 =cut
4478
4479 sub balance_date_sql {
4480   my( $class, $start, $end, %opt ) = @_;
4481
4482   my $cutoff = $opt{'cutoff'};
4483
4484   my $owed         = FS::cust_bill->owed_sql($cutoff);
4485   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4486   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4487   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4488
4489   my $j = $opt{'join'} || '';
4490
4491   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4492   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4493   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4494   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4495
4496   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4497     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4498     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4499     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4500   ";
4501
4502 }
4503
4504 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4505
4506 Returns an SQL fragment to retreive the total unapplied payments for this
4507 customer, only considering payments with date earlier than START_TIME, and
4508 optionally not later than END_TIME.
4509
4510 Times are specified as SQL fragments or numeric
4511 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4512 L<Date::Parse> for conversion functions.  The empty string can be passed
4513 to disable that time constraint completely.
4514
4515 Available options are:
4516
4517 =cut
4518
4519 sub unapplied_payments_date_sql {
4520   my( $class, $start, $end, %opt ) = @_;
4521
4522   my $cutoff = $opt{'cutoff'};
4523
4524   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4525
4526   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4527                                                           'unapplied_date'=>1 );
4528
4529   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4530 }
4531
4532 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4533
4534 Helper method for balance_date_sql; name (and usage) subject to change
4535 (suggestions welcome).
4536
4537 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4538 cust_refund, cust_credit or cust_pay).
4539
4540 If TABLE is "cust_bill" or the unapplied_date option is true, only
4541 considers records with date earlier than START_TIME, and optionally not
4542 later than END_TIME .
4543
4544 =cut
4545
4546 sub _money_table_where {
4547   my( $class, $table, $start, $end, %opt ) = @_;
4548
4549   my @where = ();
4550   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4551   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4552     push @where, "$table._date <= $start" if defined($start) && length($start);
4553     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4554   }
4555   push @where, @{$opt{'where'}} if $opt{'where'};
4556   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4557
4558   $where;
4559
4560 }
4561
4562 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4563 use FS::cust_main::Search;
4564 sub search {
4565   my $class = shift;
4566   FS::cust_main::Search->search(@_);
4567 }
4568
4569 =back
4570
4571 =head1 SUBROUTINES
4572
4573 =over 4
4574
4575 =item batch_charge
4576
4577 =cut
4578
4579 sub batch_charge {
4580   my $param = shift;
4581   #warn join('-',keys %$param);
4582   my $fh = $param->{filehandle};
4583   my $agentnum = $param->{agentnum};
4584   my $format = $param->{format};
4585
4586   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4587
4588   my @fields;
4589   if ( $format eq 'simple' ) {
4590     @fields = qw( custnum agent_custid amount pkg );
4591   } else {
4592     die "unknown format $format";
4593   }
4594
4595   eval "use Text::CSV_XS;";
4596   die $@ if $@;
4597
4598   my $csv = new Text::CSV_XS;
4599   #warn $csv;
4600   #warn $fh;
4601
4602   my $imported = 0;
4603   #my $columns;
4604
4605   local $SIG{HUP} = 'IGNORE';
4606   local $SIG{INT} = 'IGNORE';
4607   local $SIG{QUIT} = 'IGNORE';
4608   local $SIG{TERM} = 'IGNORE';
4609   local $SIG{TSTP} = 'IGNORE';
4610   local $SIG{PIPE} = 'IGNORE';
4611
4612   my $oldAutoCommit = $FS::UID::AutoCommit;
4613   local $FS::UID::AutoCommit = 0;
4614   my $dbh = dbh;
4615
4616   #while ( $columns = $csv->getline($fh) ) {
4617   my $line;
4618   while ( defined($line=<$fh>) ) {
4619
4620     $csv->parse($line) or do {
4621       $dbh->rollback if $oldAutoCommit;
4622       return "can't parse: ". $csv->error_input();
4623     };
4624
4625     my @columns = $csv->fields();
4626     #warn join('-',@columns);
4627
4628     my %row = ();
4629     foreach my $field ( @fields ) {
4630       $row{$field} = shift @columns;
4631     }
4632
4633     if ( $row{custnum} && $row{agent_custid} ) {
4634       dbh->rollback if $oldAutoCommit;
4635       return "can't specify custnum with agent_custid $row{agent_custid}";
4636     }
4637
4638     my %hash = ();
4639     if ( $row{agent_custid} && $agentnum ) {
4640       %hash = ( 'agent_custid' => $row{agent_custid},
4641                 'agentnum'     => $agentnum,
4642               );
4643     }
4644
4645     if ( $row{custnum} ) {
4646       %hash = ( 'custnum' => $row{custnum} );
4647     }
4648
4649     unless ( scalar(keys %hash) ) {
4650       $dbh->rollback if $oldAutoCommit;
4651       return "can't find customer without custnum or agent_custid and agentnum";
4652     }
4653
4654     my $cust_main = qsearchs('cust_main', { %hash } );
4655     unless ( $cust_main ) {
4656       $dbh->rollback if $oldAutoCommit;
4657       my $custnum = $row{custnum} || $row{agent_custid};
4658       return "unknown custnum $custnum";
4659     }
4660
4661     if ( $row{'amount'} > 0 ) {
4662       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4663       if ( $error ) {
4664         $dbh->rollback if $oldAutoCommit;
4665         return $error;
4666       }
4667       $imported++;
4668     } elsif ( $row{'amount'} < 0 ) {
4669       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4670                                       $row{'pkg'}                         );
4671       if ( $error ) {
4672         $dbh->rollback if $oldAutoCommit;
4673         return $error;
4674       }
4675       $imported++;
4676     } else {
4677       #hmm?
4678     }
4679
4680   }
4681
4682   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4683
4684   return "Empty file!" unless $imported;
4685
4686   ''; #no error
4687
4688 }
4689
4690 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4691
4692 Deprecated.  Use event notification and message templates
4693 (L<FS::msg_template>) instead.
4694
4695 Sends a templated email notification to the customer (see L<Text::Template>).
4696
4697 OPTIONS is a hash and may include
4698
4699 I<from> - the email sender (default is invoice_from)
4700
4701 I<to> - comma-separated scalar or arrayref of recipients
4702    (default is invoicing_list)
4703
4704 I<subject> - The subject line of the sent email notification
4705    (default is "Notice from company_name")
4706
4707 I<extra_fields> - a hashref of name/value pairs which will be substituted
4708    into the template
4709
4710 The following variables are vavailable in the template.
4711
4712 I<$first> - the customer first name
4713 I<$last> - the customer last name
4714 I<$company> - the customer company
4715 I<$payby> - a description of the method of payment for the customer
4716             # would be nice to use FS::payby::shortname
4717 I<$payinfo> - the account information used to collect for this customer
4718 I<$expdate> - the expiration of the customer payment in seconds from epoch
4719
4720 =cut
4721
4722 sub notify {
4723   my ($self, $template, %options) = @_;
4724
4725   return unless $conf->exists($template);
4726
4727   my $from = $conf->config('invoice_from', $self->agentnum)
4728     if $conf->exists('invoice_from', $self->agentnum);
4729   $from = $options{from} if exists($options{from});
4730
4731   my $to = join(',', $self->invoicing_list_emailonly);
4732   $to = $options{to} if exists($options{to});
4733
4734   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4735     if $conf->exists('company_name', $self->agentnum);
4736   $subject = $options{subject} if exists($options{subject});
4737
4738   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4739                                             SOURCE => [ map "$_\n",
4740                                               $conf->config($template)]
4741                                            )
4742     or die "can't create new Text::Template object: Text::Template::ERROR";
4743   $notify_template->compile()
4744     or die "can't compile template: Text::Template::ERROR";
4745
4746   $FS::notify_template::_template::company_name =
4747     $conf->config('company_name', $self->agentnum);
4748   $FS::notify_template::_template::company_address =
4749     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4750
4751   my $paydate = $self->paydate || '2037-12-31';
4752   $FS::notify_template::_template::first = $self->first;
4753   $FS::notify_template::_template::last = $self->last;
4754   $FS::notify_template::_template::company = $self->company;
4755   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4756   my $payby = $self->payby;
4757   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4758   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4759
4760   #credit cards expire at the end of the month/year of their exp date
4761   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4762     $FS::notify_template::_template::payby = 'credit card';
4763     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4764     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4765     $expire_time--;
4766   }elsif ($payby eq 'COMP') {
4767     $FS::notify_template::_template::payby = 'complimentary account';
4768   }else{
4769     $FS::notify_template::_template::payby = 'current method';
4770   }
4771   $FS::notify_template::_template::expdate = $expire_time;
4772
4773   for (keys %{$options{extra_fields}}){
4774     no strict "refs";
4775     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4776   }
4777
4778   send_email(from => $from,
4779              to => $to,
4780              subject => $subject,
4781              body => $notify_template->fill_in( PACKAGE =>
4782                                                 'FS::notify_template::_template'                                              ),
4783             );
4784
4785 }
4786
4787 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4788
4789 Generates a templated notification to the customer (see L<Text::Template>).
4790
4791 OPTIONS is a hash and may include
4792
4793 I<extra_fields> - a hashref of name/value pairs which will be substituted
4794    into the template.  These values may override values mentioned below
4795    and those from the customer record.
4796
4797 The following variables are available in the template instead of or in addition
4798 to the fields of the customer record.
4799
4800 I<$payby> - a description of the method of payment for the customer
4801             # would be nice to use FS::payby::shortname
4802 I<$payinfo> - the masked account information used to collect for this customer
4803 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4804 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4805
4806 =cut
4807
4808 # a lot like cust_bill::print_latex
4809 sub generate_letter {
4810   my ($self, $template, %options) = @_;
4811
4812   return unless $conf->exists($template);
4813
4814   my $letter_template = new Text::Template
4815                         ( TYPE       => 'ARRAY',
4816                           SOURCE     => [ map "$_\n", $conf->config($template)],
4817                           DELIMITERS => [ '[@--', '--@]' ],
4818                         )
4819     or die "can't create new Text::Template object: Text::Template::ERROR";
4820
4821   $letter_template->compile()
4822     or die "can't compile template: Text::Template::ERROR";
4823
4824   my %letter_data = map { $_ => $self->$_ } $self->fields;
4825   $letter_data{payinfo} = $self->mask_payinfo;
4826
4827   #my $paydate = $self->paydate || '2037-12-31';
4828   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4829
4830   my $payby = $self->payby;
4831   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4832   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4833
4834   #credit cards expire at the end of the month/year of their exp date
4835   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4836     $letter_data{payby} = 'credit card';
4837     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4838     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4839     $expire_time--;
4840   }elsif ($payby eq 'COMP') {
4841     $letter_data{payby} = 'complimentary account';
4842   }else{
4843     $letter_data{payby} = 'current method';
4844   }
4845   $letter_data{expdate} = $expire_time;
4846
4847   for (keys %{$options{extra_fields}}){
4848     $letter_data{$_} = $options{extra_fields}->{$_};
4849   }
4850
4851   unless(exists($letter_data{returnaddress})){
4852     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4853                                                   $self->agent_template)
4854                      );
4855     if ( length($retadd) ) {
4856       $letter_data{returnaddress} = $retadd;
4857     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4858       $letter_data{returnaddress} =
4859         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4860                           s/$/\\\\\*/;
4861                           $_;
4862                         }
4863                     ( $conf->config('company_name', $self->agentnum),
4864                       $conf->config('company_address', $self->agentnum),
4865                     )
4866         );
4867     } else {
4868       $letter_data{returnaddress} = '~';
4869     }
4870   }
4871
4872   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4873
4874   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4875
4876   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4877
4878   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4879                            DIR      => $dir,
4880                            SUFFIX   => '.eps',
4881                            UNLINK   => 0,
4882                          ) or die "can't open temp file: $!\n";
4883   print $lh $conf->config_binary('logo.eps', $self->agentnum)
4884     or die "can't write temp file: $!\n";
4885   close $lh;
4886   $letter_data{'logo_file'} = $lh->filename;
4887
4888   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4889                            DIR      => $dir,
4890                            SUFFIX   => '.tex',
4891                            UNLINK   => 0,
4892                          ) or die "can't open temp file: $!\n";
4893
4894   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4895   close $fh;
4896   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4897   return ($1, $letter_data{'logo_file'});
4898
4899 }
4900
4901 =item print_ps TEMPLATE
4902
4903 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4904
4905 =cut
4906
4907 sub print_ps {
4908   my $self = shift;
4909   my($file, $lfile) = $self->generate_letter(@_);
4910   my $ps = FS::Misc::generate_ps($file);
4911   unlink($file.'.tex');
4912   unlink($lfile);
4913
4914   $ps;
4915 }
4916
4917 =item print TEMPLATE
4918
4919 Prints the filled in template.
4920
4921 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4922
4923 =cut
4924
4925 sub queueable_print {
4926   my %opt = @_;
4927
4928   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4929     or die "invalid customer number: " . $opt{custnum};
4930
4931   my $error = $self->print( { 'template' => $opt{template} } );
4932   die $error if $error;
4933 }
4934
4935 sub print {
4936   my ($self, $template) = (shift, shift);
4937   do_print(
4938     [ $self->print_ps($template) ],
4939     'agentnum' => $self->agentnum,
4940   );
4941 }
4942
4943 #these three subs should just go away once agent stuff is all config overrides
4944
4945 sub agent_template {
4946   my $self = shift;
4947   $self->_agent_plandata('agent_templatename');
4948 }
4949
4950 sub agent_invoice_from {
4951   my $self = shift;
4952   $self->_agent_plandata('agent_invoice_from');
4953 }
4954
4955 sub _agent_plandata {
4956   my( $self, $option ) = @_;
4957
4958   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
4959   #agent-specific Conf
4960
4961   use FS::part_event::Condition;
4962
4963   my $agentnum = $self->agentnum;
4964
4965   my $regexp = regexp_sql();
4966
4967   my $part_event_option =
4968     qsearchs({
4969       'select'    => 'part_event_option.*',
4970       'table'     => 'part_event_option',
4971       'addl_from' => q{
4972         LEFT JOIN part_event USING ( eventpart )
4973         LEFT JOIN part_event_option AS peo_agentnum
4974           ON ( part_event.eventpart = peo_agentnum.eventpart
4975                AND peo_agentnum.optionname = 'agentnum'
4976                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4977              )
4978         LEFT JOIN part_event_condition
4979           ON ( part_event.eventpart = part_event_condition.eventpart
4980                AND part_event_condition.conditionname = 'cust_bill_age'
4981              )
4982         LEFT JOIN part_event_condition_option
4983           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4984                AND part_event_condition_option.optionname = 'age'
4985              )
4986       },
4987       #'hashref'   => { 'optionname' => $option },
4988       #'hashref'   => { 'part_event_option.optionname' => $option },
4989       'extra_sql' =>
4990         " WHERE part_event_option.optionname = ". dbh->quote($option).
4991         " AND action = 'cust_bill_send_agent' ".
4992         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4993         " AND peo_agentnum.optionname = 'agentnum' ".
4994         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4995         " ORDER BY
4996            CASE WHEN part_event_condition_option.optionname IS NULL
4997            THEN -1
4998            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4999         " END
5000           , part_event.weight".
5001         " LIMIT 1"
5002     });
5003
5004   unless ( $part_event_option ) {
5005     return $self->agent->invoice_template || ''
5006       if $option eq 'agent_templatename';
5007     return '';
5008   }
5009
5010   $part_event_option->optionvalue;
5011
5012 }
5013
5014 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5015
5016 Subroutine (not a method), designed to be called from the queue.
5017
5018 Takes a list of options and values.
5019
5020 Pulls up the customer record via the custnum option and calls bill_and_collect.
5021
5022 =cut
5023
5024 sub queued_bill {
5025   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5026
5027   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5028   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5029
5030   $cust_main->bill_and_collect( %args );
5031 }
5032
5033 sub process_bill_and_collect {
5034   my $job = shift;
5035   my $param = thaw(decode_base64(shift));
5036   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5037       or die "custnum '$param->{custnum}' not found!\n";
5038   $param->{'job'}   = $job;
5039   $param->{'fatal'} = 1; # runs from job queue, will be caught
5040   $param->{'retry'} = 1;
5041
5042   $cust_main->bill_and_collect( %$param );
5043 }
5044
5045 #starting to take quite a while for big dbs
5046 #   (JRNL: journaled so it only happens once per database)
5047 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5048 # JRNL seq scan of cust_main on signupdate... index signupdate?  will that help?
5049 # JRNL seq scan of cust_main on paydate... index on substrings?  maybe set an
5050 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5051 # JRNL leading/trailing spaces in first, last, company
5052 # JRNL migrate to cust_payby
5053 # - otaker upgrade?  journal and call it good?  (double check to make sure
5054 #    we're not still setting otaker here)
5055 #
5056 #only going to get worse with new location stuff...
5057
5058 sub _upgrade_data { #class method
5059   my ($class, %opts) = @_;
5060
5061   my @statements = (
5062     'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5063   );
5064
5065   #this seems to be the only expensive one.. why does it take so long?
5066   unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5067     push @statements,
5068       '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';
5069     FS::upgrade_journal->set_done('cust_main__signupdate');
5070   }
5071
5072   unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5073
5074     # fix yyyy-m-dd formatted paydates
5075     if ( driver_name =~ /^mysql/i ) {
5076       push @statements,
5077       "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5078     } else { # the SQL standard
5079       push @statements,
5080       "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5081     }
5082     FS::upgrade_journal->set_done('cust_main__paydate');
5083   }
5084
5085   unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5086
5087     push @statements, #fix the weird BILL with a cc# in payinfo problem
5088       #DCRD to be safe
5089       "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5090
5091     FS::upgrade_journal->set_done('cust_main__payinfo');
5092
5093   }
5094
5095   my $t = time;
5096   foreach my $sql ( @statements ) {
5097     my $sth = dbh->prepare($sql) or die dbh->errstr;
5098     $sth->execute or die $sth->errstr;
5099     #warn ( (time - $t). " seconds\n" );
5100     #$t = time;
5101   }
5102
5103   local($ignore_expired_card) = 1;
5104   local($ignore_banned_card) = 1;
5105   local($skip_fuzzyfiles) = 1;
5106   local($import) = 1; #prevent automatic geocoding (need its own variable?)
5107
5108   FS::cust_main::Location->_upgrade_data(%opts);
5109
5110   unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5111
5112     foreach my $cust_main ( qsearch({
5113       'table'     => 'cust_main',
5114       'hashref'   => {},
5115       'extra_sql' => 'WHERE '.
5116                        join(' OR ',
5117                          map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '%  %'",
5118                            qw( first last company )
5119                        ),
5120     }) ) {
5121       my $error = $cust_main->replace;
5122       die $error if $error;
5123     }
5124
5125     FS::upgrade_journal->set_done('cust_main__trimspaces');
5126
5127   }
5128
5129   unless ( FS::upgrade_journal->is_done('cust_main__cust_payby') ) {
5130
5131     #we don't want to decrypt them, just stuff them as-is into cust_payby
5132     local(@encrypted_fields) = ();
5133
5134     local($FS::cust_payby::ignore_expired_card) = 1;
5135     local($FS::cust_payby::ignore_banned_card) = 1;
5136
5137     my @payfields = qw( payby payinfo paycvv paymask
5138                         paydate paystart_month paystart_year payissue
5139                         payname paystate paytype payip
5140                       );
5141
5142     my $search = new FS::Cursor {
5143       'table'     => 'cust_main',
5144       'extra_sql' => " WHERE ( payby IS NOT NULL AND payby != '' ) ",
5145     };
5146
5147     while (my $cust_main = $search->fetch) {
5148
5149       my $cust_payby = new FS::cust_payby {
5150         'custnum' => $cust_main->custnum,
5151         'weight'  => 1,
5152         map { $_ => $cust_main->$_(); } @payfields
5153       };
5154
5155       my $error = $cust_payby->insert;
5156       die $error if $error;
5157
5158       $cust_main->setfield($_, '') foreach @payfields;
5159       $error = $cust_main->replace;
5160       die $error if $error;
5161
5162     };
5163
5164     FS::upgrade_journal->set_done('cust_main__cust_payby');
5165   }
5166
5167   $class->_upgrade_otaker(%opts);
5168
5169 }
5170
5171 =back
5172
5173 =head1 BUGS
5174
5175 The delete method.
5176
5177 The delete method should possibly take an FS::cust_main object reference
5178 instead of a scalar customer number.
5179
5180 Bill and collect options should probably be passed as references instead of a
5181 list.
5182
5183 There should probably be a configuration file with a list of allowed credit
5184 card types.
5185
5186 No multiple currency support (probably a larger project than just this module).
5187
5188 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5189
5190 Birthdates rely on negative epoch values.
5191
5192 The payby for card/check batches is broken.  With mixed batching, bad
5193 things will happen.
5194
5195 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5196
5197 =head1 SEE ALSO
5198
5199 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5200 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5201 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5202
5203 =cut
5204
5205 1;
5206