FS/FS/cust_main.pm

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