FS/FS/cust_main.pm

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