FS/FS/cust_main.pm

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