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   my $opt = ref($_[0]) ? shift : { @_ };
3789
3790   return $self->num_cust_pay unless wantarray || keys %$opt;
3791
3792   $opt->{'table'} = 'cust_pay';
3793   $opt->{'hashref'}{'custnum'} = $self->custnum;
3794
3795   map { $_ } #behavior of sort undefined in scalar context
3796     sort { $a->_date <=> $b->_date }
3797       qsearch($opt);
3798
3799 }
3800
3801 =item num_cust_pay
3802
3803 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3804 called automatically when the cust_pay method is used in a scalar context.
3805
3806 =cut
3807
3808 sub num_cust_pay {
3809   my $self = shift;
3810   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3811   my $sth = dbh->prepare($sql) or die dbh->errstr;
3812   $sth->execute($self->custnum) or die $sth->errstr;
3813   $sth->fetchrow_arrayref->[0];
3814 }
3815
3816 =item unapplied_cust_pay
3817
3818 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3819
3820 =cut
3821
3822 sub unapplied_cust_pay {
3823   my $self = shift;
3824
3825   $self->cust_pay(
3826     'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3827     #@_
3828   );
3829
3830 }
3831
3832 =item cust_pay_pkgnum
3833
3834 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3835 package when using experimental package balances.
3836
3837 =cut
3838
3839 sub cust_pay_pkgnum {
3840   my( $self, $pkgnum ) = @_;
3841   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3842   sort { $a->_date <=> $b->_date }
3843     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3844                            'pkgnum'  => $pkgnum,
3845                          }
3846     );
3847 }
3848
3849 =item cust_pay_void
3850
3851 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3852
3853 =cut
3854
3855 sub cust_pay_void {
3856   my $self = shift;
3857   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3858   sort { $a->_date <=> $b->_date }
3859     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3860 }
3861
3862 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3863
3864 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
3865
3866 Optionally, a list or hashref of additional arguments to the qsearch call can
3867 be passed.
3868
3869 =cut
3870
3871 sub cust_pay_batch {
3872   my $self = shift;
3873   my $opt = ref($_[0]) ? shift : { @_ };
3874
3875   #return $self->num_cust_statement unless wantarray || keys %$opt;
3876
3877   $opt->{'table'} = 'cust_pay_batch';
3878   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3879   $opt->{'hashref'}{'custnum'} = $self->custnum;
3880   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3881
3882   map { $_ } #behavior of sort undefined in scalar context
3883     sort { $a->paybatchnum <=> $b->paybatchnum }
3884       qsearch($opt);
3885 }
3886
3887 =item cust_pay_pending
3888
3889 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3890 (without status "done").
3891
3892 =cut
3893
3894 sub cust_pay_pending {
3895   my $self = shift;
3896   return $self->num_cust_pay_pending unless wantarray;
3897   sort { $a->_date <=> $b->_date }
3898     qsearch( 'cust_pay_pending', {
3899                                    'custnum' => $self->custnum,
3900                                    'status'  => { op=>'!=', value=>'done' },
3901                                  },
3902            );
3903 }
3904
3905 =item cust_pay_pending_attempt
3906
3907 Returns all payment attempts / declined payments for this customer, as pending
3908 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3909 a corresponding payment (see L<FS::cust_pay>).
3910
3911 =cut
3912
3913 sub cust_pay_pending_attempt {
3914   my $self = shift;
3915   return $self->num_cust_pay_pending_attempt unless wantarray;
3916   sort { $a->_date <=> $b->_date }
3917     qsearch( 'cust_pay_pending', {
3918                                    'custnum' => $self->custnum,
3919                                    'status'  => 'done',
3920                                    'paynum'  => '',
3921                                  },
3922            );
3923 }
3924
3925 =item num_cust_pay_pending
3926
3927 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3928 customer (without status "done").  Also called automatically when the
3929 cust_pay_pending method is used in a scalar context.
3930
3931 =cut
3932
3933 sub num_cust_pay_pending {
3934   my $self = shift;
3935   $self->scalar_sql(
3936     " SELECT COUNT(*) FROM cust_pay_pending ".
3937       " WHERE custnum = ? AND status != 'done' ",
3938     $self->custnum
3939   );
3940 }
3941
3942 =item num_cust_pay_pending_attempt
3943
3944 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3945 customer, with status "done" but without a corresp.  Also called automatically when the
3946 cust_pay_pending method is used in a scalar context.
3947
3948 =cut
3949
3950 sub num_cust_pay_pending_attempt {
3951   my $self = shift;
3952   $self->scalar_sql(
3953     " SELECT COUNT(*) FROM cust_pay_pending ".
3954       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3955     $self->custnum
3956   );
3957 }
3958
3959 =item cust_refund
3960
3961 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3962
3963 =cut
3964
3965 sub cust_refund {
3966   my $self = shift;
3967   map { $_ } #return $self->num_cust_refund unless wantarray;
3968   sort { $a->_date <=> $b->_date }
3969     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3970 }
3971
3972 =item display_custnum
3973
3974 Returns the displayed customer number for this customer: agent_custid if
3975 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3976
3977 =cut
3978
3979 sub display_custnum {
3980   my $self = shift;
3981
3982   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3983   if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3984     if ( $special eq 'CoStAg' ) {
3985       $prefix = uc( join('',
3986         $self->country,
3987         ($self->state =~ /^(..)/),
3988         $prefix || ($self->agent->agent =~ /^(..)/)
3989       ) );
3990     }
3991     elsif ( $special eq 'CoStCl' ) {
3992       $prefix = uc( join('',
3993         $self->country,
3994         ($self->state =~ /^(..)/),
3995         ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3996       ) );
3997     }
3998     # add any others here if needed
3999   }
4000
4001   my $length = $conf->config('cust_main-custnum-display_length');
4002   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
4003     return $self->agent_custid;
4004   } elsif ( $prefix ) {
4005     $length = 8 if !defined($length);
4006     return $prefix .
4007            sprintf('%0'.$length.'d', $self->custnum)
4008   } elsif ( $length ) {
4009     return sprintf('%0'.$length.'d', $self->custnum);
4010   } else {
4011     return $self->custnum;
4012   }
4013 }
4014
4015 =item name
4016
4017 Returns a name string for this customer, either "Company (Last, First)" or
4018 "Last, First".
4019
4020 =cut
4021
4022 sub name {
4023   my $self = shift;
4024   my $name = $self->contact;
4025   $name = $self->company. " ($name)" if $self->company;
4026   $name;
4027 }
4028
4029 =item service_contact
4030
4031 Returns the L<FS::contact> object for this customer that has the 'Service'
4032 contact class, or undef if there is no such contact.  Deprecated; don't use
4033 this in new code.
4034
4035 =cut
4036
4037 sub service_contact {
4038   my $self = shift;
4039   if ( !exists($self->{service_contact}) ) {
4040     my $classnum = $self->scalar_sql(
4041       'SELECT classnum FROM contact_class WHERE classname = \'Service\''
4042     ) || 0; #if it's zero, qsearchs will return nothing
4043     $self->{service_contact} = qsearchs('contact', {
4044         'classnum' => $classnum, 'custnum' => $self->custnum
4045       }) || undef;
4046   }
4047   $self->{service_contact};
4048 }
4049
4050 =item ship_name
4051
4052 Returns a name string for this (service/shipping) contact, either
4053 "Company (Last, First)" or "Last, First".
4054
4055 =cut
4056
4057 sub ship_name {
4058   my $self = shift;
4059
4060   my $name = $self->ship_contact;
4061   $name = $self->company. " ($name)" if $self->company;
4062   $name;
4063 }
4064
4065 =item name_short
4066
4067 Returns a name string for this customer, either "Company" or "First Last".
4068
4069 =cut
4070
4071 sub name_short {
4072   my $self = shift;
4073   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4074 }
4075
4076 =item ship_name_short
4077
4078 Returns a name string for this (service/shipping) contact, either "Company"
4079 or "First Last".
4080
4081 =cut
4082
4083 sub ship_name_short {
4084   my $self = shift;
4085   $self->service_contact
4086     ? $self->ship_contact_firstlast
4087     : $self->name_short
4088 }
4089
4090 =item contact
4091
4092 Returns this customer's full (billing) contact name only, "Last, First"
4093
4094 =cut
4095
4096 sub contact {
4097   my $self = shift;
4098   $self->get('last'). ', '. $self->first;
4099 }
4100
4101 =item ship_contact
4102
4103 Returns this customer's full (shipping) contact name only, "Last, First"
4104
4105 =cut
4106
4107 sub ship_contact {
4108   my $self = shift;
4109   my $contact = $self->service_contact || $self;
4110   $contact->get('last') . ', ' . $contact->get('first');
4111 }
4112
4113 =item contact_firstlast
4114
4115 Returns this customers full (billing) contact name only, "First Last".
4116
4117 =cut
4118
4119 sub contact_firstlast {
4120   my $self = shift;
4121   $self->first. ' '. $self->get('last');
4122 }
4123
4124 =item ship_contact_firstlast
4125
4126 Returns this customer's full (shipping) contact name only, "First Last".
4127
4128 =cut
4129
4130 sub ship_contact_firstlast {
4131   my $self = shift;
4132   my $contact = $self->service_contact || $self;
4133   $contact->get('first') . ' '. $contact->get('last');
4134 }
4135
4136 #XXX this doesn't work in 3.x+
4137 #=item country_full
4138 #
4139 #Returns this customer's full country name
4140 #
4141 #=cut
4142 #
4143 #sub country_full {
4144 #  my $self = shift;
4145 #  code2country($self->country);
4146 #}
4147
4148 sub bill_country_full {
4149   my $self = shift;
4150   code2country($self->bill_location->country);
4151 }
4152
4153 sub ship_country_full {
4154   my $self = shift;
4155   code2country($self->ship_location->country);
4156 }
4157
4158 =item county_state_county [ PREFIX ]
4159
4160 Returns a string consisting of just the county, state and country.
4161
4162 =cut
4163
4164 sub county_state_country {
4165   my $self = shift;
4166   my $locationnum;
4167   if ( @_ && $_[0] && $self->has_ship_address ) {
4168     $locationnum = $self->ship_locationnum;
4169   } else {
4170     $locationnum = $self->bill_locationnum;
4171   }
4172   my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4173   $cust_location->county_state_country;
4174 }
4175
4176 =item geocode DATA_VENDOR
4177
4178 Returns a value for the customer location as encoded by DATA_VENDOR.
4179 Currently this only makes sense for "CCH" as DATA_VENDOR.
4180
4181 =cut
4182
4183 =item cust_status
4184
4185 =item status
4186
4187 Returns a status string for this customer, currently:
4188
4189 =over 4
4190
4191 =item prospect - No packages have ever been ordered
4192
4193 =item ordered - Recurring packages all are new (not yet billed).
4194
4195 =item active - One or more recurring packages is active
4196
4197 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4198
4199 =item suspended - All non-cancelled recurring packages are suspended
4200
4201 =item cancelled - All recurring packages are cancelled
4202
4203 =back
4204
4205 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4206 cust_main-status_module configuration option.
4207
4208 =cut
4209
4210 sub status { shift->cust_status(@_); }
4211
4212 sub cust_status {
4213   my $self = shift;
4214   for my $status ( FS::cust_main->statuses() ) {
4215     my $method = $status.'_sql';
4216     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4217     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4218     $sth->execute( ($self->custnum) x $numnum )
4219       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4220     return $status if $sth->fetchrow_arrayref->[0];
4221   }
4222 }
4223
4224 =item ucfirst_cust_status
4225
4226 =item ucfirst_status
4227
4228 Returns the status with the first character capitalized.
4229
4230 =cut
4231
4232 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4233
4234 sub ucfirst_cust_status {
4235   my $self = shift;
4236   ucfirst($self->cust_status);
4237 }
4238
4239 =item statuscolor
4240
4241 Returns a hex triplet color string for this customer's status.
4242
4243 =cut
4244
4245 sub statuscolor { shift->cust_statuscolor(@_); }
4246
4247 sub cust_statuscolor {
4248   my $self = shift;
4249   __PACKAGE__->statuscolors->{$self->cust_status};
4250 }
4251
4252 =item tickets [ STATUS ]
4253
4254 Returns an array of hashes representing the customer's RT tickets.
4255
4256 An optional status (or arrayref or hashref of statuses) may be specified.
4257
4258 =cut
4259
4260 sub tickets {
4261   my $self = shift;
4262   my $status = ( @_ && $_[0] ) ? shift : '';
4263
4264   my $num = $conf->config('cust_main-max_tickets') || 10;
4265   my @tickets = ();
4266
4267   if ( $conf->config('ticket_system') ) {
4268     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4269
4270       @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4271                                                         $num,
4272                                                         undef,
4273                                                         $status,
4274                                                       )
4275                   };
4276
4277     } else {
4278
4279       foreach my $priority (
4280         $conf->config('ticket_system-custom_priority_field-values'), ''
4281       ) {
4282         last if scalar(@tickets) >= $num;
4283         push @tickets,
4284           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4285                                                  $num - scalar(@tickets),
4286                                                  $priority,
4287                                                  $status,
4288                                                )
4289            };
4290       }
4291     }
4292   }
4293   (@tickets);
4294 }
4295
4296 # Return services representing svc_accts in customer support packages
4297 sub support_services {
4298   my $self = shift;
4299   my %packages = map { $_ => 1 } $conf->config('support_packages');
4300
4301   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4302     grep { $_->part_svc->svcdb eq 'svc_acct' }
4303     map { $_->cust_svc }
4304     grep { exists $packages{ $_->pkgpart } }
4305     $self->ncancelled_pkgs;
4306
4307 }
4308
4309 # Return a list of latitude/longitude for one of the services (if any)
4310 sub service_coordinates {
4311   my $self = shift;
4312
4313   my @svc_X =
4314     grep { $_->latitude && $_->longitude }
4315     map { $_->svc_x }
4316     map { $_->cust_svc }
4317     $self->ncancelled_pkgs;
4318
4319   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4320 }
4321
4322 =item masked FIELD
4323
4324 Returns a masked version of the named field
4325
4326 =cut
4327
4328 sub masked {
4329 my ($self,$field) = @_;
4330
4331 # Show last four
4332
4333 'x'x(length($self->getfield($field))-4).
4334   substr($self->getfield($field), (length($self->getfield($field))-4));
4335
4336 }
4337
4338 =back
4339
4340 =head1 CLASS METHODS
4341
4342 =over 4
4343
4344 =item statuses
4345
4346 Class method that returns the list of possible status strings for customers
4347 (see L<the status method|/status>).  For example:
4348
4349   @statuses = FS::cust_main->statuses();
4350
4351 =cut
4352
4353 sub statuses {
4354   my $self = shift;
4355   keys %{ $self->statuscolors };
4356 }
4357
4358 =item cust_status_sql
4359
4360 Returns an SQL fragment to determine the status of a cust_main record, as a
4361 string.
4362
4363 =cut
4364
4365 sub cust_status_sql {
4366   my $sql = 'CASE';
4367   for my $status ( FS::cust_main->statuses() ) {
4368     my $method = $status.'_sql';
4369     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4370   }
4371   $sql .= ' END';
4372   return $sql;
4373 }
4374
4375
4376 =item prospect_sql
4377
4378 Returns an SQL expression identifying prospective cust_main records (customers
4379 with no packages ever ordered)
4380
4381 =cut
4382
4383 use vars qw($select_count_pkgs);
4384 $select_count_pkgs =
4385   "SELECT COUNT(*) FROM cust_pkg
4386     WHERE cust_pkg.custnum = cust_main.custnum";
4387
4388 sub select_count_pkgs_sql {
4389   $select_count_pkgs;
4390 }
4391
4392 sub prospect_sql {
4393   " 0 = ( $select_count_pkgs ) ";
4394 }
4395
4396 =item ordered_sql
4397
4398 Returns an SQL expression identifying ordered cust_main records (customers with
4399 no active packages, but recurring packages not yet setup or one time charges
4400 not yet billed).
4401
4402 =cut
4403
4404 sub ordered_sql {
4405   FS::cust_main->none_active_sql.
4406   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4407 }
4408
4409 =item active_sql
4410
4411 Returns an SQL expression identifying active cust_main records (customers with
4412 active recurring packages).
4413
4414 =cut
4415
4416 sub active_sql {
4417   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4418 }
4419
4420 =item none_active_sql
4421
4422 Returns an SQL expression identifying cust_main records with no active
4423 recurring packages.  This includes customers of status prospect, ordered,
4424 inactive, and suspended.
4425
4426 =cut
4427
4428 sub none_active_sql {
4429   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4430 }
4431
4432 =item inactive_sql
4433
4434 Returns an SQL expression identifying inactive cust_main records (customers with
4435 no active recurring packages, but otherwise unsuspended/uncancelled).
4436
4437 =cut
4438
4439 sub inactive_sql {
4440   FS::cust_main->none_active_sql.
4441   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4442 }
4443
4444 =item susp_sql
4445 =item suspended_sql
4446
4447 Returns an SQL expression identifying suspended cust_main records.
4448
4449 =cut
4450
4451
4452 sub suspended_sql { susp_sql(@_); }
4453 sub susp_sql {
4454   FS::cust_main->none_active_sql.
4455   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4456 }
4457
4458 =item cancel_sql
4459 =item cancelled_sql
4460
4461 Returns an SQL expression identifying cancelled cust_main records.
4462
4463 =cut
4464
4465 sub cancel_sql { shift->cancelled_sql(@_); }
4466
4467 =item uncancel_sql
4468 =item uncancelled_sql
4469
4470 Returns an SQL expression identifying un-cancelled cust_main records.
4471
4472 =cut
4473
4474 sub uncancelled_sql { uncancel_sql(@_); }
4475 sub uncancel_sql { "
4476   ( 0 < ( $select_count_pkgs
4477                    AND ( cust_pkg.cancel IS NULL
4478                          OR cust_pkg.cancel = 0
4479                        )
4480         )
4481     OR 0 = ( $select_count_pkgs )
4482   )
4483 "; }
4484
4485 =item balance_sql
4486
4487 Returns an SQL fragment to retreive the balance.
4488
4489 =cut
4490
4491 sub balance_sql { "
4492     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4493         WHERE cust_bill.custnum   = cust_main.custnum     )
4494   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4495         WHERE cust_pay.custnum    = cust_main.custnum     )
4496   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4497         WHERE cust_credit.custnum = cust_main.custnum     )
4498   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4499         WHERE cust_refund.custnum = cust_main.custnum     )
4500 "; }
4501
4502 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4503
4504 Returns an SQL fragment to retreive the balance for this customer, optionally
4505 considering invoices with date earlier than START_TIME, and not
4506 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4507 total_unapplied_payments).
4508
4509 Times are specified as SQL fragments or numeric
4510 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4511 L<Date::Parse> for conversion functions.  The empty string can be passed
4512 to disable that time constraint completely.
4513
4514 Available options are:
4515
4516 =over 4
4517
4518 =item unapplied_date
4519
4520 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)
4521
4522 =item total
4523
4524 (unused.  obsolete?)
4525 set to true to remove all customer comparison clauses, for totals
4526
4527 =item where
4528
4529 (unused.  obsolete?)
4530 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4531
4532 =item join
4533
4534 (unused.  obsolete?)
4535 JOIN clause (typically used with the total option)
4536
4537 =item cutoff
4538
4539 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4540 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4541 range for invoices and I<unapplied> payments, credits, and refunds.
4542
4543 =back
4544
4545 =cut
4546
4547 sub balance_date_sql {
4548   my( $class, $start, $end, %opt ) = @_;
4549
4550   my $cutoff = $opt{'cutoff'};
4551
4552   my $owed         = FS::cust_bill->owed_sql($cutoff);
4553   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4554   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4555   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4556
4557   my $j = $opt{'join'} || '';
4558
4559   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4560   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4561   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4562   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4563
4564   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4565     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4566     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4567     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4568   ";
4569
4570 }
4571
4572 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4573
4574 Returns an SQL fragment to retreive the total unapplied payments for this
4575 customer, only considering payments with date earlier than START_TIME, and
4576 optionally not later than END_TIME.
4577
4578 Times are specified as SQL fragments or numeric
4579 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4580 L<Date::Parse> for conversion functions.  The empty string can be passed
4581 to disable that time constraint completely.
4582
4583 Available options are:
4584
4585 =cut
4586
4587 sub unapplied_payments_date_sql {
4588   my( $class, $start, $end, %opt ) = @_;
4589
4590   my $cutoff = $opt{'cutoff'};
4591
4592   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4593
4594   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4595                                                           'unapplied_date'=>1 );
4596
4597   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4598 }
4599
4600 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4601
4602 Helper method for balance_date_sql; name (and usage) subject to change
4603 (suggestions welcome).
4604
4605 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4606 cust_refund, cust_credit or cust_pay).
4607
4608 If TABLE is "cust_bill" or the unapplied_date option is true, only
4609 considers records with date earlier than START_TIME, and optionally not
4610 later than END_TIME .
4611
4612 =cut
4613
4614 sub _money_table_where {
4615   my( $class, $table, $start, $end, %opt ) = @_;
4616
4617   my @where = ();
4618   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4619   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4620     push @where, "$table._date <= $start" if defined($start) && length($start);
4621     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4622   }
4623   push @where, @{$opt{'where'}} if $opt{'where'};
4624   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4625
4626   $where;
4627
4628 }
4629
4630 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4631 use FS::cust_main::Search;
4632 sub search {
4633   my $class = shift;
4634   FS::cust_main::Search->search(@_);
4635 }
4636
4637 =back
4638
4639 =head1 SUBROUTINES
4640
4641 =over 4
4642
4643 =item batch_charge
4644
4645 =cut
4646
4647 sub batch_charge {
4648   my $param = shift;
4649   #warn join('-',keys %$param);
4650   my $fh = $param->{filehandle};
4651   my $agentnum = $param->{agentnum};
4652   my $format = $param->{format};
4653
4654   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4655
4656   my @fields;
4657   if ( $format eq 'simple' ) {
4658     @fields = qw( custnum agent_custid amount pkg );
4659   } else {
4660     die "unknown format $format";
4661   }
4662
4663   eval "use Text::CSV_XS;";
4664   die $@ if $@;
4665
4666   my $csv = new Text::CSV_XS;
4667   #warn $csv;
4668   #warn $fh;
4669
4670   my $imported = 0;
4671   #my $columns;
4672
4673   local $SIG{HUP} = 'IGNORE';
4674   local $SIG{INT} = 'IGNORE';
4675   local $SIG{QUIT} = 'IGNORE';
4676   local $SIG{TERM} = 'IGNORE';
4677   local $SIG{TSTP} = 'IGNORE';
4678   local $SIG{PIPE} = 'IGNORE';
4679
4680   my $oldAutoCommit = $FS::UID::AutoCommit;
4681   local $FS::UID::AutoCommit = 0;
4682   my $dbh = dbh;
4683
4684   #while ( $columns = $csv->getline($fh) ) {
4685   my $line;
4686   while ( defined($line=<$fh>) ) {
4687
4688     $csv->parse($line) or do {
4689       $dbh->rollback if $oldAutoCommit;
4690       return "can't parse: ". $csv->error_input();
4691     };
4692
4693     my @columns = $csv->fields();
4694     #warn join('-',@columns);
4695
4696     my %row = ();
4697     foreach my $field ( @fields ) {
4698       $row{$field} = shift @columns;
4699     }
4700
4701     if ( $row{custnum} && $row{agent_custid} ) {
4702       dbh->rollback if $oldAutoCommit;
4703       return "can't specify custnum with agent_custid $row{agent_custid}";
4704     }
4705
4706     my %hash = ();
4707     if ( $row{agent_custid} && $agentnum ) {
4708       %hash = ( 'agent_custid' => $row{agent_custid},
4709                 'agentnum'     => $agentnum,
4710               );
4711     }
4712
4713     if ( $row{custnum} ) {
4714       %hash = ( 'custnum' => $row{custnum} );
4715     }
4716
4717     unless ( scalar(keys %hash) ) {
4718       $dbh->rollback if $oldAutoCommit;
4719       return "can't find customer without custnum or agent_custid and agentnum";
4720     }
4721
4722     my $cust_main = qsearchs('cust_main', { %hash } );
4723     unless ( $cust_main ) {
4724       $dbh->rollback if $oldAutoCommit;
4725       my $custnum = $row{custnum} || $row{agent_custid};
4726       return "unknown custnum $custnum";
4727     }
4728
4729     if ( $row{'amount'} > 0 ) {
4730       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4731       if ( $error ) {
4732         $dbh->rollback if $oldAutoCommit;
4733         return $error;
4734       }
4735       $imported++;
4736     } elsif ( $row{'amount'} < 0 ) {
4737       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4738                                       $row{'pkg'}                         );
4739       if ( $error ) {
4740         $dbh->rollback if $oldAutoCommit;
4741         return $error;
4742       }
4743       $imported++;
4744     } else {
4745       #hmm?
4746     }
4747
4748   }
4749
4750   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4751
4752   return "Empty file!" unless $imported;
4753
4754   ''; #no error
4755
4756 }
4757
4758 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4759
4760 Deprecated.  Use event notification and message templates
4761 (L<FS::msg_template>) instead.
4762
4763 Sends a templated email notification to the customer (see L<Text::Template>).
4764
4765 OPTIONS is a hash and may include
4766
4767 I<from> - the email sender (default is invoice_from)
4768
4769 I<to> - comma-separated scalar or arrayref of recipients
4770    (default is invoicing_list)
4771
4772 I<subject> - The subject line of the sent email notification
4773    (default is "Notice from company_name")
4774
4775 I<extra_fields> - a hashref of name/value pairs which will be substituted
4776    into the template
4777
4778 The following variables are vavailable in the template.
4779
4780 I<$first> - the customer first name
4781 I<$last> - the customer last name
4782 I<$company> - the customer company
4783 I<$payby> - a description of the method of payment for the customer
4784             # would be nice to use FS::payby::shortname
4785 I<$payinfo> - the account information used to collect for this customer
4786 I<$expdate> - the expiration of the customer payment in seconds from epoch
4787
4788 =cut
4789
4790 sub notify {
4791   my ($self, $template, %options) = @_;
4792
4793   return unless $conf->exists($template);
4794
4795   my $from = $conf->config('invoice_from', $self->agentnum)
4796     if $conf->exists('invoice_from', $self->agentnum);
4797   $from = $options{from} if exists($options{from});
4798
4799   my $to = join(',', $self->invoicing_list_emailonly);
4800   $to = $options{to} if exists($options{to});
4801
4802   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4803     if $conf->exists('company_name', $self->agentnum);
4804   $subject = $options{subject} if exists($options{subject});
4805
4806   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4807                                             SOURCE => [ map "$_\n",
4808                                               $conf->config($template)]
4809                                            )
4810     or die "can't create new Text::Template object: Text::Template::ERROR";
4811   $notify_template->compile()
4812     or die "can't compile template: Text::Template::ERROR";
4813
4814   $FS::notify_template::_template::company_name =
4815     $conf->config('company_name', $self->agentnum);
4816   $FS::notify_template::_template::company_address =
4817     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4818
4819   my $paydate = $self->paydate || '2037-12-31';
4820   $FS::notify_template::_template::first = $self->first;
4821   $FS::notify_template::_template::last = $self->last;
4822   $FS::notify_template::_template::company = $self->company;
4823   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4824   my $payby = $self->payby;
4825   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4826   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4827
4828   #credit cards expire at the end of the month/year of their exp date
4829   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4830     $FS::notify_template::_template::payby = 'credit card';
4831     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4832     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4833     $expire_time--;
4834   }elsif ($payby eq 'COMP') {
4835     $FS::notify_template::_template::payby = 'complimentary account';
4836   }else{
4837     $FS::notify_template::_template::payby = 'current method';
4838   }
4839   $FS::notify_template::_template::expdate = $expire_time;
4840
4841   for (keys %{$options{extra_fields}}){
4842     no strict "refs";
4843     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4844   }
4845
4846   send_email(from => $from,
4847              to => $to,
4848              subject => $subject,
4849              body => $notify_template->fill_in( PACKAGE =>
4850                                                 'FS::notify_template::_template'                                              ),
4851             );
4852
4853 }
4854
4855 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4856
4857 Generates a templated notification to the customer (see L<Text::Template>).
4858
4859 OPTIONS is a hash and may include
4860
4861 I<extra_fields> - a hashref of name/value pairs which will be substituted
4862    into the template.  These values may override values mentioned below
4863    and those from the customer record.
4864
4865 The following variables are available in the template instead of or in addition
4866 to the fields of the customer record.
4867
4868 I<$payby> - a description of the method of payment for the customer
4869             # would be nice to use FS::payby::shortname
4870 I<$payinfo> - the masked account information used to collect for this customer
4871 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4872 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4873
4874 =cut
4875
4876 # a lot like cust_bill::print_latex
4877 sub generate_letter {
4878   my ($self, $template, %options) = @_;
4879
4880   return unless $conf->exists($template);
4881
4882   my $letter_template = new Text::Template
4883                         ( TYPE       => 'ARRAY',
4884                           SOURCE     => [ map "$_\n", $conf->config($template)],
4885                           DELIMITERS => [ '[@--', '--@]' ],
4886                         )
4887     or die "can't create new Text::Template object: Text::Template::ERROR";
4888
4889   $letter_template->compile()
4890     or die "can't compile template: Text::Template::ERROR";
4891
4892   my %letter_data = map { $_ => $self->$_ } $self->fields;
4893   $letter_data{payinfo} = $self->mask_payinfo;
4894
4895   #my $paydate = $self->paydate || '2037-12-31';
4896   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4897
4898   my $payby = $self->payby;
4899   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4900   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4901
4902   #credit cards expire at the end of the month/year of their exp date
4903   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4904     $letter_data{payby} = 'credit card';
4905     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4906     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4907     $expire_time--;
4908   }elsif ($payby eq 'COMP') {
4909     $letter_data{payby} = 'complimentary account';
4910   }else{
4911     $letter_data{payby} = 'current method';
4912   }
4913   $letter_data{expdate} = $expire_time;
4914
4915   for (keys %{$options{extra_fields}}){
4916     $letter_data{$_} = $options{extra_fields}->{$_};
4917   }
4918
4919   unless(exists($letter_data{returnaddress})){
4920     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4921                                                   $self->agent_template)
4922                      );
4923     if ( length($retadd) ) {
4924       $letter_data{returnaddress} = $retadd;
4925     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4926       $letter_data{returnaddress} =
4927         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4928                           s/$/\\\\\*/;
4929                           $_;
4930                         }
4931                     ( $conf->config('company_name', $self->agentnum),
4932                       $conf->config('company_address', $self->agentnum),
4933                     )
4934         );
4935     } else {
4936       $letter_data{returnaddress} = '~';
4937     }
4938   }
4939
4940   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4941
4942   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4943
4944   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4945
4946   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4947                            DIR      => $dir,
4948                            SUFFIX   => '.eps',
4949                            UNLINK   => 0,
4950                          ) or die "can't open temp file: $!\n";
4951   print $lh $conf->config_binary('logo.eps', $self->agentnum)
4952     or die "can't write temp file: $!\n";
4953   close $lh;
4954   $letter_data{'logo_file'} = $lh->filename;
4955
4956   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4957                            DIR      => $dir,
4958                            SUFFIX   => '.tex',
4959                            UNLINK   => 0,
4960                          ) or die "can't open temp file: $!\n";
4961
4962   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4963   close $fh;
4964   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4965   return ($1, $letter_data{'logo_file'});
4966
4967 }
4968
4969 =item print_ps TEMPLATE
4970
4971 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4972
4973 =cut
4974
4975 sub print_ps {
4976   my $self = shift;
4977   my($file, $lfile) = $self->generate_letter(@_);
4978   my $ps = FS::Misc::generate_ps($file);
4979   unlink($file.'.tex');
4980   unlink($lfile);
4981
4982   $ps;
4983 }
4984
4985 =item print TEMPLATE
4986
4987 Prints the filled in template.
4988
4989 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4990
4991 =cut
4992
4993 sub queueable_print {
4994   my %opt = @_;
4995
4996   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4997     or die "invalid customer number: " . $opt{custnum};
4998
4999   my $error = $self->print( { 'template' => $opt{template} } );
5000   die $error if $error;
5001 }
5002
5003 sub print {
5004   my ($self, $template) = (shift, shift);
5005   do_print(
5006     [ $self->print_ps($template) ],
5007     'agentnum' => $self->agentnum,
5008   );
5009 }
5010
5011 #these three subs should just go away once agent stuff is all config overrides
5012
5013 sub agent_template {
5014   my $self = shift;
5015   $self->_agent_plandata('agent_templatename');
5016 }
5017
5018 sub agent_invoice_from {
5019   my $self = shift;
5020   $self->_agent_plandata('agent_invoice_from');
5021 }
5022
5023 sub _agent_plandata {
5024   my( $self, $option ) = @_;
5025
5026   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
5027   #agent-specific Conf
5028
5029   use FS::part_event::Condition;
5030
5031   my $agentnum = $self->agentnum;
5032
5033   my $regexp = regexp_sql();
5034
5035   my $part_event_option =
5036     qsearchs({
5037       'select'    => 'part_event_option.*',
5038       'table'     => 'part_event_option',
5039       'addl_from' => q{
5040         LEFT JOIN part_event USING ( eventpart )
5041         LEFT JOIN part_event_option AS peo_agentnum
5042           ON ( part_event.eventpart = peo_agentnum.eventpart
5043                AND peo_agentnum.optionname = 'agentnum'
5044                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5045              )
5046         LEFT JOIN part_event_condition
5047           ON ( part_event.eventpart = part_event_condition.eventpart
5048                AND part_event_condition.conditionname = 'cust_bill_age'
5049              )
5050         LEFT JOIN part_event_condition_option
5051           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5052                AND part_event_condition_option.optionname = 'age'
5053              )
5054       },
5055       #'hashref'   => { 'optionname' => $option },
5056       #'hashref'   => { 'part_event_option.optionname' => $option },
5057       'extra_sql' =>
5058         " WHERE part_event_option.optionname = ". dbh->quote($option).
5059         " AND action = 'cust_bill_send_agent' ".
5060         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5061         " AND peo_agentnum.optionname = 'agentnum' ".
5062         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5063         " ORDER BY
5064            CASE WHEN part_event_condition_option.optionname IS NULL
5065            THEN -1
5066            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5067         " END
5068           , part_event.weight".
5069         " LIMIT 1"
5070     });
5071
5072   unless ( $part_event_option ) {
5073     return $self->agent->invoice_template || ''
5074       if $option eq 'agent_templatename';
5075     return '';
5076   }
5077
5078   $part_event_option->optionvalue;
5079
5080 }
5081
5082 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5083
5084 Subroutine (not a method), designed to be called from the queue.
5085
5086 Takes a list of options and values.
5087
5088 Pulls up the customer record via the custnum option and calls bill_and_collect.
5089
5090 =cut
5091
5092 sub queued_bill {
5093   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5094
5095   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5096   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5097
5098   #without this errors don't get rolled back
5099   $args{'fatal'} = 1; # runs from job queue, will be caught
5100
5101   $cust_main->bill_and_collect( %args );
5102 }
5103
5104 sub process_bill_and_collect {
5105   my $job = shift;
5106   my $param = thaw(decode_base64(shift));
5107   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5108       or die "custnum '$param->{custnum}' not found!\n";
5109   $param->{'job'}   = $job;
5110   $param->{'fatal'} = 1; # runs from job queue, will be caught
5111   $param->{'retry'} = 1;
5112
5113   $cust_main->bill_and_collect( %$param );
5114 }
5115
5116 #starting to take quite a while for big dbs
5117 #   (JRNL: journaled so it only happens once per database)
5118 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5119 # JRNL seq scan of cust_main on signupdate... index signupdate?  will that help?
5120 # JRNL seq scan of cust_main on paydate... index on substrings?  maybe set an
5121 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5122 # JRNL leading/trailing spaces in first, last, company
5123 # - otaker upgrade?  journal and call it good?  (double check to make sure
5124 #    we're not still setting otaker here)
5125 #
5126 #only going to get worse with new location stuff...
5127
5128 sub _upgrade_data { #class method
5129   my ($class, %opts) = @_;
5130
5131   my @statements = (
5132     'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5133   );
5134
5135   #this seems to be the only expensive one.. why does it take so long?
5136   unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5137     push @statements,
5138       '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';
5139     FS::upgrade_journal->set_done('cust_main__signupdate');
5140   }
5141
5142   unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5143
5144     # fix yyyy-m-dd formatted paydates
5145     if ( driver_name =~ /^mysql/i ) {
5146       push @statements,
5147       "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5148     } else { # the SQL standard
5149       push @statements,
5150       "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5151     }
5152     FS::upgrade_journal->set_done('cust_main__paydate');
5153   }
5154
5155   unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5156
5157     push @statements, #fix the weird BILL with a cc# in payinfo problem
5158       #DCRD to be safe
5159       "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5160
5161     FS::upgrade_journal->set_done('cust_main__payinfo');
5162
5163   }
5164
5165   my $t = time;
5166   foreach my $sql ( @statements ) {
5167     my $sth = dbh->prepare($sql) or die dbh->errstr;
5168     $sth->execute or die $sth->errstr;
5169     #warn ( (time - $t). " seconds\n" );
5170     #$t = time;
5171   }
5172
5173   local($ignore_expired_card) = 1;
5174   local($ignore_banned_card) = 1;
5175   local($skip_fuzzyfiles) = 1;
5176   local($import) = 1; #prevent automatic geocoding (need its own variable?)
5177
5178   FS::cust_main::Location->_upgrade_data(%opts);
5179
5180   unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5181
5182     foreach my $cust_main ( qsearch({
5183       'table'     => 'cust_main',
5184       'hashref'   => {},
5185       'extra_sql' => 'WHERE '.
5186                        join(' OR ',
5187                          map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '%  %'",
5188                            qw( first last company )
5189                        ),
5190     }) ) {
5191       my $error = $cust_main->replace;
5192       die $error if $error;
5193     }
5194
5195     FS::upgrade_journal->set_done('cust_main__trimspaces');
5196
5197   }
5198
5199   $class->_upgrade_otaker(%opts);
5200
5201 }
5202
5203 =back
5204
5205 =head1 BUGS
5206
5207 The delete method.
5208
5209 The delete method should possibly take an FS::cust_main object reference
5210 instead of a scalar customer number.
5211
5212 Bill and collect options should probably be passed as references instead of a
5213 list.
5214
5215 There should probably be a configuration file with a list of allowed credit
5216 card types.
5217
5218 No multiple currency support (probably a larger project than just this module).
5219
5220 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5221
5222 Birthdates rely on negative epoch values.
5223
5224 The payby for card/check batches is broken.  With mixed batching, bad
5225 things will happen.
5226
5227 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5228
5229 =head1 SEE ALSO
5230
5231 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5232 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5233 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5234
5235 =cut
5236
5237 1;
5238