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 Available options are:
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 =back
2851
2852 =cut
2853
2854 sub balance_date_range {
2855   my $self = shift;
2856   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2857             ') FROM cust_main WHERE custnum='. $self->custnum;
2858   sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2859 }
2860
2861 =item balance_pkgnum PKGNUM
2862
2863 Returns the balance for this customer's specific package when using
2864 experimental package balances (total_owed plus total_unrefunded, minus
2865 total_unapplied_credits minus total_unapplied_payments)
2866
2867 =cut
2868
2869 sub balance_pkgnum {
2870   my( $self, $pkgnum ) = @_;
2871
2872   sprintf( "%.2f",
2873       $self->total_owed_pkgnum($pkgnum)
2874 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2875 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
2876     - $self->total_unapplied_credits_pkgnum($pkgnum)
2877     - $self->total_unapplied_payments_pkgnum($pkgnum)
2878   );
2879 }
2880
2881 =item in_transit_payments
2882
2883 Returns the total of requests for payments for this customer pending in
2884 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
2885
2886 =cut
2887
2888 sub in_transit_payments {
2889   my $self = shift;
2890   my $in_transit_payments = 0;
2891   foreach my $pay_batch ( qsearch('pay_batch', {
2892     'status' => 'I',
2893   } ) ) {
2894     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2895       'batchnum' => $pay_batch->batchnum,
2896       'custnum' => $self->custnum,
2897     } ) ) {
2898       $in_transit_payments += $cust_pay_batch->amount;
2899     }
2900   }
2901   sprintf( "%.2f", $in_transit_payments );
2902 }
2903
2904 =item payment_info
2905
2906 Returns a hash of useful information for making a payment.
2907
2908 =over 4
2909
2910 =item balance
2911
2912 Current balance.
2913
2914 =item payby
2915
2916 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2917 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2918 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2919
2920 =back
2921
2922 For credit card transactions:
2923
2924 =over 4
2925
2926 =item card_type 1
2927
2928 =item payname
2929
2930 Exact name on card
2931
2932 =back
2933
2934 For electronic check transactions:
2935
2936 =over 4
2937
2938 =item stateid_state
2939
2940 =back
2941
2942 =cut
2943
2944 sub payment_info {
2945   my $self = shift;
2946
2947   my %return = ();
2948
2949   $return{balance} = $self->balance;
2950
2951   $return{payname} = $self->payname
2952                      || ( $self->first. ' '. $self->get('last') );
2953
2954   $return{$_} = $self->bill_location->$_
2955     for qw(address1 address2 city state zip);
2956
2957   $return{payby} = $self->payby;
2958   $return{stateid_state} = $self->stateid_state;
2959
2960   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2961     $return{card_type} = cardtype($self->payinfo);
2962     $return{payinfo} = $self->paymask;
2963
2964     @return{'month', 'year'} = $self->paydate_monthyear;
2965
2966   }
2967
2968   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2969     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2970     $return{payinfo1} = $payinfo1;
2971     $return{payinfo2} = $payinfo2;
2972     $return{paytype}  = $self->paytype;
2973     $return{paystate} = $self->paystate;
2974
2975   }
2976
2977   #doubleclick protection
2978   my $_date = time;
2979   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2980
2981   %return;
2982
2983 }
2984
2985 =item paydate_monthyear
2986
2987 Returns a two-element list consisting of the month and year of this customer's
2988 paydate (credit card expiration date for CARD customers)
2989
2990 =cut
2991
2992 sub paydate_monthyear {
2993   my $self = shift;
2994   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2995     ( $2, $1 );
2996   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2997     ( $1, $3 );
2998   } else {
2999     ('', '');
3000   }
3001 }
3002
3003 =item paydate_epoch
3004
3005 Returns the exact time in seconds corresponding to the payment method
3006 expiration date.  For CARD/DCRD customers this is the end of the month;
3007 for others (COMP is the only other payby that uses paydate) it's the start.
3008 Returns 0 if the paydate is empty or set to the far future.
3009
3010 =cut
3011
3012 sub paydate_epoch {
3013   my $self = shift;
3014   my ($month, $year) = $self->paydate_monthyear;
3015   return 0 if !$year or $year >= 2037;
3016   if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
3017     $month++;
3018     if ( $month == 13 ) {
3019       $month = 1;
3020       $year++;
3021     }
3022     return timelocal(0,0,0,1,$month-1,$year) - 1;
3023   }
3024   else {
3025     return timelocal(0,0,0,1,$month-1,$year);
3026   }
3027 }
3028
3029 =item paydate_epoch_sql
3030
3031 Class method.  Returns an SQL expression to obtain the payment expiration date
3032 as a number of seconds.
3033
3034 =cut
3035
3036 # Special expiration date behavior for non-CARD/DCRD customers has been
3037 # carefully preserved.  Do we really use that?
3038 sub paydate_epoch_sql {
3039   my $class = shift;
3040   my $table = shift || 'cust_main';
3041   my ($case1, $case2);
3042   if ( driver_name eq 'Pg' ) {
3043     $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
3044     $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
3045   }
3046   elsif ( lc(driver_name) eq 'mysql' ) {
3047     $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
3048     $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
3049   }
3050   else { return '' }
3051   return "CASE WHEN $table.payby IN('CARD','DCRD')
3052   THEN ($case1)
3053   ELSE ($case2)
3054   END"
3055 }
3056
3057 =item tax_exemption TAXNAME
3058
3059 =cut
3060
3061 sub tax_exemption {
3062   my( $self, $taxname ) = @_;
3063
3064   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3065                                      'taxname' => $taxname,
3066                                    },
3067           );
3068 }
3069
3070 =item cust_main_exemption
3071
3072 =cut
3073
3074 sub cust_main_exemption {
3075   my $self = shift;
3076   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3077 }
3078
3079 =item invoicing_list [ ARRAYREF ]
3080
3081 If an arguement is given, sets these email addresses as invoice recipients
3082 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3083 (except as warnings), so use check_invoicing_list first.
3084
3085 Returns a list of email addresses (with svcnum entries expanded).
3086
3087 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3088 check it without disturbing anything by passing nothing.
3089
3090 This interface may change in the future.
3091
3092 =cut
3093
3094 sub invoicing_list {
3095   my( $self, $arrayref ) = @_;
3096
3097   if ( $arrayref ) {
3098     my @cust_main_invoice;
3099     if ( $self->custnum ) {
3100       @cust_main_invoice =
3101         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3102     } else {
3103       @cust_main_invoice = ();
3104     }
3105     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3106       #warn $cust_main_invoice->destnum;
3107       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3108         #warn $cust_main_invoice->destnum;
3109         my $error = $cust_main_invoice->delete;
3110         warn $error if $error;
3111       }
3112     }
3113     if ( $self->custnum ) {
3114       @cust_main_invoice =
3115         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3116     } else {
3117       @cust_main_invoice = ();
3118     }
3119     my %seen = map { $_->address => 1 } @cust_main_invoice;
3120     foreach my $address ( @{$arrayref} ) {
3121       next if exists $seen{$address} && $seen{$address};
3122       $seen{$address} = 1;
3123       my $cust_main_invoice = new FS::cust_main_invoice ( {
3124         'custnum' => $self->custnum,
3125         'dest'    => $address,
3126       } );
3127       my $error = $cust_main_invoice->insert;
3128       warn $error if $error;
3129     }
3130   }
3131
3132   if ( $self->custnum ) {
3133     map { $_->address }
3134       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3135   } else {
3136     ();
3137   }
3138
3139 }
3140
3141 =item check_invoicing_list ARRAYREF
3142
3143 Checks these arguements as valid input for the invoicing_list method.  If there
3144 is an error, returns the error, otherwise returns false.
3145
3146 =cut
3147
3148 sub check_invoicing_list {
3149   my( $self, $arrayref ) = @_;
3150
3151   foreach my $address ( @$arrayref ) {
3152
3153     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3154       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3155     }
3156
3157     my $cust_main_invoice = new FS::cust_main_invoice ( {
3158       'custnum' => $self->custnum,
3159       'dest'    => $address,
3160     } );
3161     my $error = $self->custnum
3162                 ? $cust_main_invoice->check
3163                 : $cust_main_invoice->checkdest
3164     ;
3165     return $error if $error;
3166
3167   }
3168
3169   return "Email address required"
3170     if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3171     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3172
3173   '';
3174 }
3175
3176 =item set_default_invoicing_list
3177
3178 Sets the invoicing list to all accounts associated with this customer,
3179 overwriting any previous invoicing list.
3180
3181 =cut
3182
3183 sub set_default_invoicing_list {
3184   my $self = shift;
3185   $self->invoicing_list($self->all_emails);
3186 }
3187
3188 =item all_emails
3189
3190 Returns the email addresses of all accounts provisioned for this customer.
3191
3192 =cut
3193
3194 sub all_emails {
3195   my $self = shift;
3196   my %list;
3197   foreach my $cust_pkg ( $self->all_pkgs ) {
3198     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3199     my @svc_acct =
3200       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3201         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3202           @cust_svc;
3203     $list{$_}=1 foreach map { $_->email } @svc_acct;
3204   }
3205   keys %list;
3206 }
3207
3208 =item invoicing_list_addpost
3209
3210 Adds postal invoicing to this customer.  If this customer is already configured
3211 to receive postal invoices, does nothing.
3212
3213 =cut
3214
3215 sub invoicing_list_addpost {
3216   my $self = shift;
3217   return if grep { $_ eq 'POST' } $self->invoicing_list;
3218   my @invoicing_list = $self->invoicing_list;
3219   push @invoicing_list, 'POST';
3220   $self->invoicing_list(\@invoicing_list);
3221 }
3222
3223 =item invoicing_list_emailonly
3224
3225 Returns the list of email invoice recipients (invoicing_list without non-email
3226 destinations such as POST and FAX).
3227
3228 =cut
3229
3230 sub invoicing_list_emailonly {
3231   my $self = shift;
3232   warn "$me invoicing_list_emailonly called"
3233     if $DEBUG;
3234   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3235 }
3236
3237 =item invoicing_list_emailonly_scalar
3238
3239 Returns the list of email invoice recipients (invoicing_list without non-email
3240 destinations such as POST and FAX) as a comma-separated scalar.
3241
3242 =cut
3243
3244 sub invoicing_list_emailonly_scalar {
3245   my $self = shift;
3246   warn "$me invoicing_list_emailonly_scalar called"
3247     if $DEBUG;
3248   join(', ', $self->invoicing_list_emailonly);
3249 }
3250
3251 =item referral_custnum_cust_main
3252
3253 Returns the customer who referred this customer (or the empty string, if
3254 this customer was not referred).
3255
3256 Note the difference with referral_cust_main method: This method,
3257 referral_custnum_cust_main returns the single customer (if any) who referred
3258 this customer, while referral_cust_main returns an array of customers referred
3259 BY this customer.
3260
3261 =cut
3262
3263 sub referral_custnum_cust_main {
3264   my $self = shift;
3265   return '' unless $self->referral_custnum;
3266   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3267 }
3268
3269 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3270
3271 Returns an array of customers referred by this customer (referral_custnum set
3272 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3273 customers referred by customers referred by this customer and so on, inclusive.
3274 The default behavior is DEPTH 1 (no recursion).
3275
3276 Note the difference with referral_custnum_cust_main method: This method,
3277 referral_cust_main, returns an array of customers referred BY this customer,
3278 while referral_custnum_cust_main returns the single customer (if any) who
3279 referred this customer.
3280
3281 =cut
3282
3283 sub referral_cust_main {
3284   my $self = shift;
3285   my $depth = @_ ? shift : 1;
3286   my $exclude = @_ ? shift : {};
3287
3288   my @cust_main =
3289     map { $exclude->{$_->custnum}++; $_; }
3290       grep { ! $exclude->{ $_->custnum } }
3291         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3292
3293   if ( $depth > 1 ) {
3294     push @cust_main,
3295       map { $_->referral_cust_main($depth-1, $exclude) }
3296         @cust_main;
3297   }
3298
3299   @cust_main;
3300 }
3301
3302 =item referral_cust_main_ncancelled
3303
3304 Same as referral_cust_main, except only returns customers with uncancelled
3305 packages.
3306
3307 =cut
3308
3309 sub referral_cust_main_ncancelled {
3310   my $self = shift;
3311   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3312 }
3313
3314 =item referral_cust_pkg [ DEPTH ]
3315
3316 Like referral_cust_main, except returns a flat list of all unsuspended (and
3317 uncancelled) packages for each customer.  The number of items in this list may
3318 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3319
3320 =cut
3321
3322 sub referral_cust_pkg {
3323   my $self = shift;
3324   my $depth = @_ ? shift : 1;
3325
3326   map { $_->unsuspended_pkgs }
3327     grep { $_->unsuspended_pkgs }
3328       $self->referral_cust_main($depth);
3329 }
3330
3331 =item referring_cust_main
3332
3333 Returns the single cust_main record for the customer who referred this customer
3334 (referral_custnum), or false.
3335
3336 =cut
3337
3338 sub referring_cust_main {
3339   my $self = shift;
3340   return '' unless $self->referral_custnum;
3341   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3342 }
3343
3344 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3345
3346 Applies a credit to this customer.  If there is an error, returns the error,
3347 otherwise returns false.
3348
3349 REASON can be a text string, an FS::reason object, or a scalar reference to
3350 a reasonnum.  If a text string, it will be automatically inserted as a new
3351 reason, and a 'reason_type' option must be passed to indicate the
3352 FS::reason_type for the new reason.
3353
3354 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3355 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3356 I<commission_pkgnum>.
3357
3358 Any other options are passed to FS::cust_credit::insert.
3359
3360 =cut
3361
3362 sub credit {
3363   my( $self, $amount, $reason, %options ) = @_;
3364
3365   my $cust_credit = new FS::cust_credit {
3366     'custnum' => $self->custnum,
3367     'amount'  => $amount,
3368   };
3369
3370   if ( ref($reason) ) {
3371
3372     if ( ref($reason) eq 'SCALAR' ) {
3373       $cust_credit->reasonnum( $$reason );
3374     } else {
3375       $cust_credit->reasonnum( $reason->reasonnum );
3376     }
3377
3378   } else {
3379     $cust_credit->set('reason', $reason)
3380   }
3381
3382   $cust_credit->$_( delete $options{$_} )
3383     foreach grep exists($options{$_}),
3384               qw( addlinfo eventnum ),
3385               map "commission_$_", qw( agentnum salesnum pkgnum );
3386
3387   $cust_credit->insert(%options);
3388
3389 }
3390
3391 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3392
3393 Creates a one-time charge for this customer.  If there is an error, returns
3394 the error, otherwise returns false.
3395
3396 New-style, with a hashref of options:
3397
3398   my $error = $cust_main->charge(
3399                                   {
3400                                     'amount'     => 54.32,
3401                                     'quantity'   => 1,
3402                                     'start_date' => str2time('7/4/2009'),
3403                                     'pkg'        => 'Description',
3404                                     'comment'    => 'Comment',
3405                                     'additional' => [], #extra invoice detail
3406                                     'classnum'   => 1,  #pkg_class
3407
3408                                     'setuptax'   => '', # or 'Y' for tax exempt
3409
3410                                     'locationnum'=> 1234, # optional
3411
3412                                     #internal taxation
3413                                     'taxclass'   => 'Tax class',
3414
3415                                     #vendor taxation
3416                                     'taxproduct' => 2,  #part_pkg_taxproduct
3417                                     'override'   => {}, #XXX describe
3418
3419                                     #will be filled in with the new object
3420                                     'cust_pkg_ref' => \$cust_pkg,
3421
3422                                     #generate an invoice immediately
3423                                     'bill_now' => 0,
3424                                     'invoice_terms' => '', #with these terms
3425                                   }
3426                                 );
3427
3428 Old-style:
3429
3430   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3431
3432 =cut
3433
3434 sub charge {
3435   my $self = shift;
3436   my ( $amount, $quantity, $start_date, $classnum );
3437   my ( $pkg, $comment, $additional );
3438   my ( $setuptax, $taxclass );   #internal taxes
3439   my ( $taxproduct, $override ); #vendor (CCH) taxes
3440   my $no_auto = '';
3441   my $cust_pkg_ref = '';
3442   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3443   my $locationnum;
3444   if ( ref( $_[0] ) ) {
3445     $amount     = $_[0]->{amount};
3446     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3447     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3448     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3449     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3450     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3451                                            : '$'. sprintf("%.2f",$amount);
3452     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3453     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3454     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3455     $additional = $_[0]->{additional} || [];
3456     $taxproduct = $_[0]->{taxproductnum};
3457     $override   = { '' => $_[0]->{tax_override} };
3458     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3459     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3460     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3461     $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3462   } else {
3463     $amount     = shift;
3464     $quantity   = 1;
3465     $start_date = '';
3466     $pkg        = @_ ? shift : 'One-time charge';
3467     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3468     $setuptax   = '';
3469     $taxclass   = @_ ? shift : '';
3470     $additional = [];
3471   }
3472
3473   local $SIG{HUP} = 'IGNORE';
3474   local $SIG{INT} = 'IGNORE';
3475   local $SIG{QUIT} = 'IGNORE';
3476   local $SIG{TERM} = 'IGNORE';
3477   local $SIG{TSTP} = 'IGNORE';
3478   local $SIG{PIPE} = 'IGNORE';
3479
3480   my $oldAutoCommit = $FS::UID::AutoCommit;
3481   local $FS::UID::AutoCommit = 0;
3482   my $dbh = dbh;
3483
3484   my $part_pkg = new FS::part_pkg ( {
3485     'pkg'           => $pkg,
3486     'comment'       => $comment,
3487     'plan'          => 'flat',
3488     'freq'          => 0,
3489     'disabled'      => 'Y',
3490     'classnum'      => ( $classnum ? $classnum : '' ),
3491     'setuptax'      => $setuptax,
3492     'taxclass'      => $taxclass,
3493     'taxproductnum' => $taxproduct,
3494   } );
3495
3496   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3497                         ( 0 .. @$additional - 1 )
3498                   ),
3499                   'additional_count' => scalar(@$additional),
3500                   'setup_fee' => $amount,
3501                 );
3502
3503   my $error = $part_pkg->insert( options       => \%options,
3504                                  tax_overrides => $override,
3505                                );
3506   if ( $error ) {
3507     $dbh->rollback if $oldAutoCommit;
3508     return $error;
3509   }
3510
3511   my $pkgpart = $part_pkg->pkgpart;
3512   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3513   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3514     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3515     $error = $type_pkgs->insert;
3516     if ( $error ) {
3517       $dbh->rollback if $oldAutoCommit;
3518       return $error;
3519     }
3520   }
3521
3522   my $cust_pkg = new FS::cust_pkg ( {
3523     'custnum'    => $self->custnum,
3524     'pkgpart'    => $pkgpart,
3525     'quantity'   => $quantity,
3526     'start_date' => $start_date,
3527     'no_auto'    => $no_auto,
3528     'locationnum'=> $locationnum,
3529   } );
3530
3531   $error = $cust_pkg->insert;
3532   if ( $error ) {
3533     $dbh->rollback if $oldAutoCommit;
3534     return $error;
3535   } elsif ( $cust_pkg_ref ) {
3536     ${$cust_pkg_ref} = $cust_pkg;
3537   }
3538
3539   if ( $bill_now ) {
3540     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3541                              'pkg_list'      => [ $cust_pkg ],
3542                            );
3543     if ( $error ) {
3544       $dbh->rollback if $oldAutoCommit;
3545       return $error;
3546     }
3547   }
3548
3549   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3550   return '';
3551
3552 }
3553
3554 #=item charge_postal_fee
3555 #
3556 #Applies a one time charge this customer.  If there is an error,
3557 #returns the error, returns the cust_pkg charge object or false
3558 #if there was no charge.
3559 #
3560 #=cut
3561 #
3562 # This should be a customer event.  For that to work requires that bill
3563 # also be a customer event.
3564
3565 sub charge_postal_fee {
3566   my $self = shift;
3567
3568   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3569   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3570
3571   my $cust_pkg = new FS::cust_pkg ( {
3572     'custnum'  => $self->custnum,
3573     'pkgpart'  => $pkgpart,
3574     'quantity' => 1,
3575   } );
3576
3577   my $error = $cust_pkg->insert;
3578   $error ? $error : $cust_pkg;
3579 }
3580
3581 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3582
3583 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3584
3585 Optionally, a list or hashref of additional arguments to the qsearch call can
3586 be passed.
3587
3588 =cut
3589
3590 sub cust_bill {
3591   my $self = shift;
3592   my $opt = ref($_[0]) ? shift : { @_ };
3593
3594   #return $self->num_cust_bill unless wantarray || keys %$opt;
3595
3596   $opt->{'table'} = 'cust_bill';
3597   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3598   $opt->{'hashref'}{'custnum'} = $self->custnum;
3599   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3600
3601   map { $_ } #behavior of sort undefined in scalar context
3602     sort { $a->_date <=> $b->_date }
3603       qsearch($opt);
3604 }
3605
3606 =item open_cust_bill
3607
3608 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3609 customer.
3610
3611 =cut
3612
3613 sub open_cust_bill {
3614   my $self = shift;
3615
3616   $self->cust_bill(
3617     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3618     #@_
3619   );
3620
3621 }
3622
3623 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3624
3625 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3626
3627 =cut
3628
3629 sub legacy_cust_bill {
3630   my $self = shift;
3631
3632   #return $self->num_legacy_cust_bill unless wantarray;
3633
3634   map { $_ } #behavior of sort undefined in scalar context
3635     sort { $a->_date <=> $b->_date }
3636       qsearch({ 'table'    => 'legacy_cust_bill',
3637                 'hashref'  => { 'custnum' => $self->custnum, },
3638                 'order_by' => 'ORDER BY _date ASC',
3639              });
3640 }
3641
3642 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3643
3644 Returns all the statements (see L<FS::cust_statement>) for this customer.
3645
3646 Optionally, a list or hashref of additional arguments to the qsearch call can
3647 be passed.
3648
3649 =cut
3650
3651 =item cust_bill_void
3652
3653 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3654
3655 =cut
3656
3657 sub cust_bill_void {
3658   my $self = shift;
3659
3660   map { $_ } #return $self->num_cust_bill_void unless wantarray;
3661   sort { $a->_date <=> $b->_date }
3662     qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3663 }
3664
3665 sub cust_statement {
3666   my $self = shift;
3667   my $opt = ref($_[0]) ? shift : { @_ };
3668
3669   #return $self->num_cust_statement unless wantarray || keys %$opt;
3670
3671   $opt->{'table'} = 'cust_statement';
3672   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3673   $opt->{'hashref'}{'custnum'} = $self->custnum;
3674   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3675
3676   map { $_ } #behavior of sort undefined in scalar context
3677     sort { $a->_date <=> $b->_date }
3678       qsearch($opt);
3679 }
3680
3681 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3682
3683 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3684
3685 Optionally, a list or hashref of additional arguments to the qsearch call can
3686 be passed following the SVCDB.
3687
3688 =cut
3689
3690 sub svc_x {
3691   my $self = shift;
3692   my $svcdb = shift;
3693   if ( ! $svcdb =~ /^svc_\w+$/ ) {
3694     warn "$me svc_x requires a svcdb";
3695     return;
3696   }
3697   my $opt = ref($_[0]) ? shift : { @_ };
3698
3699   $opt->{'table'} = $svcdb;
3700   $opt->{'addl_from'} =
3701     'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3702     ($opt->{'addl_from'} || '');
3703
3704   my $custnum = $self->custnum;
3705   $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3706   my $where = "cust_pkg.custnum = $custnum";
3707
3708   my $extra_sql = $opt->{'extra_sql'} || '';
3709   if ( keys %{ $opt->{'hashref'} } ) {
3710     $extra_sql = " AND $where $extra_sql";
3711   }
3712   else {
3713     if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3714       $extra_sql = "WHERE $where AND $1";
3715     }
3716     else {
3717       $extra_sql = "WHERE $where $extra_sql";
3718     }
3719   }
3720   $opt->{'extra_sql'} = $extra_sql;
3721
3722   qsearch($opt);
3723 }
3724
3725 # required for use as an eventtable;
3726 sub svc_acct {
3727   my $self = shift;
3728   $self->svc_x('svc_acct', @_);
3729 }
3730
3731 =item cust_credit
3732
3733 Returns all the credits (see L<FS::cust_credit>) for this customer.
3734
3735 =cut
3736
3737 sub cust_credit {
3738   my $self = shift;
3739   map { $_ } #return $self->num_cust_credit unless wantarray;
3740   sort { $a->_date <=> $b->_date }
3741     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3742 }
3743
3744 =item cust_credit_pkgnum
3745
3746 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3747 package when using experimental package balances.
3748
3749 =cut
3750
3751 sub cust_credit_pkgnum {
3752   my( $self, $pkgnum ) = @_;
3753   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3754   sort { $a->_date <=> $b->_date }
3755     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3756                               'pkgnum'  => $pkgnum,
3757                             }
3758     );
3759 }
3760
3761 =item cust_credit_void
3762
3763 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3764
3765 =cut
3766
3767 sub cust_credit_void {
3768   my $self = shift;
3769   map { $_ }
3770   sort { $a->_date <=> $b->_date }
3771     qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3772 }
3773
3774 =item cust_pay
3775
3776 Returns all the payments (see L<FS::cust_pay>) for this customer.
3777
3778 =cut
3779
3780 sub cust_pay {
3781   my $self = shift;
3782   return $self->num_cust_pay unless wantarray;
3783   sort { $a->_date <=> $b->_date }
3784     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3785 }
3786
3787 =item num_cust_pay
3788
3789 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3790 called automatically when the cust_pay method is used in a scalar context.
3791
3792 =cut
3793
3794 sub num_cust_pay {
3795   my $self = shift;
3796   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3797   my $sth = dbh->prepare($sql) or die dbh->errstr;
3798   $sth->execute($self->custnum) or die $sth->errstr;
3799   $sth->fetchrow_arrayref->[0];
3800 }
3801
3802 =item cust_pay_pkgnum
3803
3804 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3805 package when using experimental package balances.
3806
3807 =cut
3808
3809 sub cust_pay_pkgnum {
3810   my( $self, $pkgnum ) = @_;
3811   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3812   sort { $a->_date <=> $b->_date }
3813     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3814                            'pkgnum'  => $pkgnum,
3815                          }
3816     );
3817 }
3818
3819 =item cust_pay_void
3820
3821 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3822
3823 =cut
3824
3825 sub cust_pay_void {
3826   my $self = shift;
3827   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3828   sort { $a->_date <=> $b->_date }
3829     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3830 }
3831
3832 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3833
3834 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
3835
3836 Optionally, a list or hashref of additional arguments to the qsearch call can
3837 be passed.
3838
3839 =cut
3840
3841 sub cust_pay_batch {
3842   my $self = shift;
3843   my $opt = ref($_[0]) ? shift : { @_ };
3844
3845   #return $self->num_cust_statement unless wantarray || keys %$opt;
3846
3847   $opt->{'table'} = 'cust_pay_batch';
3848   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3849   $opt->{'hashref'}{'custnum'} = $self->custnum;
3850   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3851
3852   map { $_ } #behavior of sort undefined in scalar context
3853     sort { $a->paybatchnum <=> $b->paybatchnum }
3854       qsearch($opt);
3855 }
3856
3857 =item cust_pay_pending
3858
3859 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3860 (without status "done").
3861
3862 =cut
3863
3864 sub cust_pay_pending {
3865   my $self = shift;
3866   return $self->num_cust_pay_pending unless wantarray;
3867   sort { $a->_date <=> $b->_date }
3868     qsearch( 'cust_pay_pending', {
3869                                    'custnum' => $self->custnum,
3870                                    'status'  => { op=>'!=', value=>'done' },
3871                                  },
3872            );
3873 }
3874
3875 =item cust_pay_pending_attempt
3876
3877 Returns all payment attempts / declined payments for this customer, as pending
3878 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3879 a corresponding payment (see L<FS::cust_pay>).
3880
3881 =cut
3882
3883 sub cust_pay_pending_attempt {
3884   my $self = shift;
3885   return $self->num_cust_pay_pending_attempt unless wantarray;
3886   sort { $a->_date <=> $b->_date }
3887     qsearch( 'cust_pay_pending', {
3888                                    'custnum' => $self->custnum,
3889                                    'status'  => 'done',
3890                                    'paynum'  => '',
3891                                  },
3892            );
3893 }
3894
3895 =item num_cust_pay_pending
3896
3897 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3898 customer (without status "done").  Also called automatically when the
3899 cust_pay_pending method is used in a scalar context.
3900
3901 =cut
3902
3903 sub num_cust_pay_pending {
3904   my $self = shift;
3905   $self->scalar_sql(
3906     " SELECT COUNT(*) FROM cust_pay_pending ".
3907       " WHERE custnum = ? AND status != 'done' ",
3908     $self->custnum
3909   );
3910 }
3911
3912 =item num_cust_pay_pending_attempt
3913
3914 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3915 customer, with status "done" but without a corresp.  Also called automatically when the
3916 cust_pay_pending method is used in a scalar context.
3917
3918 =cut
3919
3920 sub num_cust_pay_pending_attempt {
3921   my $self = shift;
3922   $self->scalar_sql(
3923     " SELECT COUNT(*) FROM cust_pay_pending ".
3924       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3925     $self->custnum
3926   );
3927 }
3928
3929 =item cust_refund
3930
3931 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3932
3933 =cut
3934
3935 sub cust_refund {
3936   my $self = shift;
3937   map { $_ } #return $self->num_cust_refund unless wantarray;
3938   sort { $a->_date <=> $b->_date }
3939     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3940 }
3941
3942 =item display_custnum
3943
3944 Returns the displayed customer number for this customer: agent_custid if
3945 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3946
3947 =cut
3948
3949 sub display_custnum {
3950   my $self = shift;
3951
3952   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3953   if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3954     if ( $special eq 'CoStAg' ) {
3955       $prefix = uc( join('',
3956         $self->country,
3957         ($self->state =~ /^(..)/),
3958         $prefix || ($self->agent->agent =~ /^(..)/)
3959       ) );
3960     }
3961     elsif ( $special eq 'CoStCl' ) {
3962       $prefix = uc( join('',
3963         $self->country,
3964         ($self->state =~ /^(..)/),
3965         ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3966       ) );
3967     }
3968     # add any others here if needed
3969   }
3970
3971   my $length = $conf->config('cust_main-custnum-display_length');
3972   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3973     return $self->agent_custid;
3974   } elsif ( $prefix ) {
3975     $length = 8 if !defined($length);
3976     return $prefix .
3977            sprintf('%0'.$length.'d', $self->custnum)
3978   } elsif ( $length ) {
3979     return sprintf('%0'.$length.'d', $self->custnum);
3980   } else {
3981     return $self->custnum;
3982   }
3983 }
3984
3985 =item name
3986
3987 Returns a name string for this customer, either "Company (Last, First)" or
3988 "Last, First".
3989
3990 =cut
3991
3992 sub name {
3993   my $self = shift;
3994   my $name = $self->contact;
3995   $name = $self->company. " ($name)" if $self->company;
3996   $name;
3997 }
3998
3999 =item service_contact
4000
4001 Returns the L<FS::contact> object for this customer that has the 'Service'
4002 contact class, or undef if there is no such contact.  Deprecated; don't use
4003 this in new code.
4004
4005 =cut
4006
4007 sub service_contact {
4008   my $self = shift;
4009   if ( !exists($self->{service_contact}) ) {
4010     my $classnum = $self->scalar_sql(
4011       'SELECT classnum FROM contact_class WHERE classname = \'Service\''
4012     ) || 0; #if it's zero, qsearchs will return nothing
4013     $self->{service_contact} = qsearchs('contact', {
4014         'classnum' => $classnum, 'custnum' => $self->custnum
4015       }) || undef;
4016   }
4017   $self->{service_contact};
4018 }
4019
4020 =item ship_name
4021
4022 Returns a name string for this (service/shipping) contact, either
4023 "Company (Last, First)" or "Last, First".
4024
4025 =cut
4026
4027 sub ship_name {
4028   my $self = shift;
4029
4030   my $name = $self->ship_contact;
4031   $name = $self->company. " ($name)" if $self->company;
4032   $name;
4033 }
4034
4035 =item name_short
4036
4037 Returns a name string for this customer, either "Company" or "First Last".
4038
4039 =cut
4040
4041 sub name_short {
4042   my $self = shift;
4043   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4044 }
4045
4046 =item ship_name_short
4047
4048 Returns a name string for this (service/shipping) contact, either "Company"
4049 or "First Last".
4050
4051 =cut
4052
4053 sub ship_name_short {
4054   my $self = shift;
4055   $self->service_contact
4056     ? $self->ship_contact_firstlast
4057     : $self->name_short
4058 }
4059
4060 =item contact
4061
4062 Returns this customer's full (billing) contact name only, "Last, First"
4063
4064 =cut
4065
4066 sub contact {
4067   my $self = shift;
4068   $self->get('last'). ', '. $self->first;
4069 }
4070
4071 =item ship_contact
4072
4073 Returns this customer's full (shipping) contact name only, "Last, First"
4074
4075 =cut
4076
4077 sub ship_contact {
4078   my $self = shift;
4079   my $contact = $self->service_contact || $self;
4080   $contact->get('last') . ', ' . $contact->get('first');
4081 }
4082
4083 =item contact_firstlast
4084
4085 Returns this customers full (billing) contact name only, "First Last".
4086
4087 =cut
4088
4089 sub contact_firstlast {
4090   my $self = shift;
4091   $self->first. ' '. $self->get('last');
4092 }
4093
4094 =item ship_contact_firstlast
4095
4096 Returns this customer's full (shipping) contact name only, "First Last".
4097
4098 =cut
4099
4100 sub ship_contact_firstlast {
4101   my $self = shift;
4102   my $contact = $self->service_contact || $self;
4103   $contact->get('first') . ' '. $contact->get('last');
4104 }
4105
4106 #XXX this doesn't work in 3.x+
4107 #=item country_full
4108 #
4109 #Returns this customer's full country name
4110 #
4111 #=cut
4112 #
4113 #sub country_full {
4114 #  my $self = shift;
4115 #  code2country($self->country);
4116 #}
4117
4118 sub bill_country_full {
4119   my $self = shift;
4120   code2country($self->bill_location->country);
4121 }
4122
4123 sub ship_country_full {
4124   my $self = shift;
4125   code2country($self->ship_location->country);
4126 }
4127
4128 =item county_state_county [ PREFIX ]
4129
4130 Returns a string consisting of just the county, state and country.
4131
4132 =cut
4133
4134 sub county_state_country {
4135   my $self = shift;
4136   my $locationnum;
4137   if ( @_ && $_[0] && $self->has_ship_address ) {
4138     $locationnum = $self->ship_locationnum;
4139   } else {
4140     $locationnum = $self->bill_locationnum;
4141   }
4142   my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4143   $cust_location->county_state_country;
4144 }
4145
4146 =item geocode DATA_VENDOR
4147
4148 Returns a value for the customer location as encoded by DATA_VENDOR.
4149 Currently this only makes sense for "CCH" as DATA_VENDOR.
4150
4151 =cut
4152
4153 =item cust_status
4154
4155 =item status
4156
4157 Returns a status string for this customer, currently:
4158
4159 =over 4
4160
4161 =item prospect - No packages have ever been ordered
4162
4163 =item ordered - Recurring packages all are new (not yet billed).
4164
4165 =item active - One or more recurring packages is active
4166
4167 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4168
4169 =item suspended - All non-cancelled recurring packages are suspended
4170
4171 =item cancelled - All recurring packages are cancelled
4172
4173 =back
4174
4175 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4176 cust_main-status_module configuration option.
4177
4178 =cut
4179
4180 sub status { shift->cust_status(@_); }
4181
4182 sub cust_status {
4183   my $self = shift;
4184   for my $status ( FS::cust_main->statuses() ) {
4185     my $method = $status.'_sql';
4186     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4187     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4188     $sth->execute( ($self->custnum) x $numnum )
4189       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4190     return $status if $sth->fetchrow_arrayref->[0];
4191   }
4192 }
4193
4194 =item ucfirst_cust_status
4195
4196 =item ucfirst_status
4197
4198 Returns the status with the first character capitalized.
4199
4200 =cut
4201
4202 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4203
4204 sub ucfirst_cust_status {
4205   my $self = shift;
4206   ucfirst($self->cust_status);
4207 }
4208
4209 =item statuscolor
4210
4211 Returns a hex triplet color string for this customer's status.
4212
4213 =cut
4214
4215 sub statuscolor { shift->cust_statuscolor(@_); }
4216
4217 sub cust_statuscolor {
4218   my $self = shift;
4219   __PACKAGE__->statuscolors->{$self->cust_status};
4220 }
4221
4222 =item tickets [ STATUS ]
4223
4224 Returns an array of hashes representing the customer's RT tickets.
4225
4226 An optional status (or arrayref or hashref of statuses) may be specified.
4227
4228 =cut
4229
4230 sub tickets {
4231   my $self = shift;
4232   my $status = ( @_ && $_[0] ) ? shift : '';
4233
4234   my $num = $conf->config('cust_main-max_tickets') || 10;
4235   my @tickets = ();
4236
4237   if ( $conf->config('ticket_system') ) {
4238     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4239
4240       @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4241                                                         $num,
4242                                                         undef,
4243                                                         $status,
4244                                                       )
4245                   };
4246
4247     } else {
4248
4249       foreach my $priority (
4250         $conf->config('ticket_system-custom_priority_field-values'), ''
4251       ) {
4252         last if scalar(@tickets) >= $num;
4253         push @tickets,
4254           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4255                                                  $num - scalar(@tickets),
4256                                                  $priority,
4257                                                  $status,
4258                                                )
4259            };
4260       }
4261     }
4262   }
4263   (@tickets);
4264 }
4265
4266 # Return services representing svc_accts in customer support packages
4267 sub support_services {
4268   my $self = shift;
4269   my %packages = map { $_ => 1 } $conf->config('support_packages');
4270
4271   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4272     grep { $_->part_svc->svcdb eq 'svc_acct' }
4273     map { $_->cust_svc }
4274     grep { exists $packages{ $_->pkgpart } }
4275     $self->ncancelled_pkgs;
4276
4277 }
4278
4279 # Return a list of latitude/longitude for one of the services (if any)
4280 sub service_coordinates {
4281   my $self = shift;
4282
4283   my @svc_X =
4284     grep { $_->latitude && $_->longitude }
4285     map { $_->svc_x }
4286     map { $_->cust_svc }
4287     $self->ncancelled_pkgs;
4288
4289   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4290 }
4291
4292 =item masked FIELD
4293
4294 Returns a masked version of the named field
4295
4296 =cut
4297
4298 sub masked {
4299 my ($self,$field) = @_;
4300
4301 # Show last four
4302
4303 'x'x(length($self->getfield($field))-4).
4304   substr($self->getfield($field), (length($self->getfield($field))-4));
4305
4306 }
4307
4308 =back
4309
4310 =head1 CLASS METHODS
4311
4312 =over 4
4313
4314 =item statuses
4315
4316 Class method that returns the list of possible status strings for customers
4317 (see L<the status method|/status>).  For example:
4318
4319   @statuses = FS::cust_main->statuses();
4320
4321 =cut
4322
4323 sub statuses {
4324   my $self = shift;
4325   keys %{ $self->statuscolors };
4326 }
4327
4328 =item cust_status_sql
4329
4330 Returns an SQL fragment to determine the status of a cust_main record, as a
4331 string.
4332
4333 =cut
4334
4335 sub cust_status_sql {
4336   my $sql = 'CASE';
4337   for my $status ( FS::cust_main->statuses() ) {
4338     my $method = $status.'_sql';
4339     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4340   }
4341   $sql .= ' END';
4342   return $sql;
4343 }
4344
4345
4346 =item prospect_sql
4347
4348 Returns an SQL expression identifying prospective cust_main records (customers
4349 with no packages ever ordered)
4350
4351 =cut
4352
4353 use vars qw($select_count_pkgs);
4354 $select_count_pkgs =
4355   "SELECT COUNT(*) FROM cust_pkg
4356     WHERE cust_pkg.custnum = cust_main.custnum";
4357
4358 sub select_count_pkgs_sql {
4359   $select_count_pkgs;
4360 }
4361
4362 sub prospect_sql {
4363   " 0 = ( $select_count_pkgs ) ";
4364 }
4365
4366 =item ordered_sql
4367
4368 Returns an SQL expression identifying ordered cust_main records (customers with
4369 no active packages, but recurring packages not yet setup or one time charges
4370 not yet billed).
4371
4372 =cut
4373
4374 sub ordered_sql {
4375   FS::cust_main->none_active_sql.
4376   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4377 }
4378
4379 =item active_sql
4380
4381 Returns an SQL expression identifying active cust_main records (customers with
4382 active recurring packages).
4383
4384 =cut
4385
4386 sub active_sql {
4387   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4388 }
4389
4390 =item none_active_sql
4391
4392 Returns an SQL expression identifying cust_main records with no active
4393 recurring packages.  This includes customers of status prospect, ordered,
4394 inactive, and suspended.
4395
4396 =cut
4397
4398 sub none_active_sql {
4399   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4400 }
4401
4402 =item inactive_sql
4403
4404 Returns an SQL expression identifying inactive cust_main records (customers with
4405 no active recurring packages, but otherwise unsuspended/uncancelled).
4406
4407 =cut
4408
4409 sub inactive_sql {
4410   FS::cust_main->none_active_sql.
4411   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4412 }
4413
4414 =item susp_sql
4415 =item suspended_sql
4416
4417 Returns an SQL expression identifying suspended cust_main records.
4418
4419 =cut
4420
4421
4422 sub suspended_sql { susp_sql(@_); }
4423 sub susp_sql {
4424   FS::cust_main->none_active_sql.
4425   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4426 }
4427
4428 =item cancel_sql
4429 =item cancelled_sql
4430
4431 Returns an SQL expression identifying cancelled cust_main records.
4432
4433 =cut
4434
4435 sub cancel_sql { shift->cancelled_sql(@_); }
4436
4437 =item uncancel_sql
4438 =item uncancelled_sql
4439
4440 Returns an SQL expression identifying un-cancelled cust_main records.
4441
4442 =cut
4443
4444 sub uncancelled_sql { uncancel_sql(@_); }
4445 sub uncancel_sql { "
4446   ( 0 < ( $select_count_pkgs
4447                    AND ( cust_pkg.cancel IS NULL
4448                          OR cust_pkg.cancel = 0
4449                        )
4450         )
4451     OR 0 = ( $select_count_pkgs )
4452   )
4453 "; }
4454
4455 =item balance_sql
4456
4457 Returns an SQL fragment to retreive the balance.
4458
4459 =cut
4460
4461 sub balance_sql { "
4462     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4463         WHERE cust_bill.custnum   = cust_main.custnum     )
4464   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4465         WHERE cust_pay.custnum    = cust_main.custnum     )
4466   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4467         WHERE cust_credit.custnum = cust_main.custnum     )
4468   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4469         WHERE cust_refund.custnum = cust_main.custnum     )
4470 "; }
4471
4472 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4473
4474 Returns an SQL fragment to retreive the balance for this customer, optionally
4475 considering invoices with date earlier than START_TIME, and not
4476 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4477 total_unapplied_payments).
4478
4479 Times are specified as SQL fragments or numeric
4480 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4481 L<Date::Parse> for conversion functions.  The empty string can be passed
4482 to disable that time constraint completely.
4483
4484 Available options are:
4485
4486 =over 4
4487
4488 =item unapplied_date
4489
4490 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)
4491
4492 =item total
4493
4494 (unused.  obsolete?)
4495 set to true to remove all customer comparison clauses, for totals
4496
4497 =item where
4498
4499 (unused.  obsolete?)
4500 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4501
4502 =item join
4503
4504 (unused.  obsolete?)
4505 JOIN clause (typically used with the total option)
4506
4507 =item cutoff
4508
4509 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4510 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4511 range for invoices and I<unapplied> payments, credits, and refunds.
4512
4513 =back
4514
4515 =cut
4516
4517 sub balance_date_sql {
4518   my( $class, $start, $end, %opt ) = @_;
4519
4520   my $cutoff = $opt{'cutoff'};
4521
4522   my $owed         = FS::cust_bill->owed_sql($cutoff);
4523   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4524   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4525   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4526
4527   my $j = $opt{'join'} || '';
4528
4529   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4530   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4531   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4532   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4533
4534   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4535     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4536     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4537     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4538   ";
4539
4540 }
4541
4542 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4543
4544 Returns an SQL fragment to retreive the total unapplied payments for this
4545 customer, only considering payments with date earlier than START_TIME, and
4546 optionally not later than END_TIME.
4547
4548 Times are specified as SQL fragments or numeric
4549 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4550 L<Date::Parse> for conversion functions.  The empty string can be passed
4551 to disable that time constraint completely.
4552
4553 Available options are:
4554
4555 =cut
4556
4557 sub unapplied_payments_date_sql {
4558   my( $class, $start, $end, %opt ) = @_;
4559
4560   my $cutoff = $opt{'cutoff'};
4561
4562   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4563
4564   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4565                                                           'unapplied_date'=>1 );
4566
4567   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4568 }
4569
4570 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4571
4572 Helper method for balance_date_sql; name (and usage) subject to change
4573 (suggestions welcome).
4574
4575 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4576 cust_refund, cust_credit or cust_pay).
4577
4578 If TABLE is "cust_bill" or the unapplied_date option is true, only
4579 considers records with date earlier than START_TIME, and optionally not
4580 later than END_TIME .
4581
4582 =cut
4583
4584 sub _money_table_where {
4585   my( $class, $table, $start, $end, %opt ) = @_;
4586
4587   my @where = ();
4588   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4589   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4590     push @where, "$table._date <= $start" if defined($start) && length($start);
4591     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4592   }
4593   push @where, @{$opt{'where'}} if $opt{'where'};
4594   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4595
4596   $where;
4597
4598 }
4599
4600 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4601 use FS::cust_main::Search;
4602 sub search {
4603   my $class = shift;
4604   FS::cust_main::Search->search(@_);
4605 }
4606
4607 =back
4608
4609 =head1 SUBROUTINES
4610
4611 =over 4
4612
4613 =item batch_charge
4614
4615 =cut
4616
4617 sub batch_charge {
4618   my $param = shift;
4619   #warn join('-',keys %$param);
4620   my $fh = $param->{filehandle};
4621   my $agentnum = $param->{agentnum};
4622   my $format = $param->{format};
4623
4624   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4625
4626   my @fields;
4627   if ( $format eq 'simple' ) {
4628     @fields = qw( custnum agent_custid amount pkg );
4629   } else {
4630     die "unknown format $format";
4631   }
4632
4633   eval "use Text::CSV_XS;";
4634   die $@ if $@;
4635
4636   my $csv = new Text::CSV_XS;
4637   #warn $csv;
4638   #warn $fh;
4639
4640   my $imported = 0;
4641   #my $columns;
4642
4643   local $SIG{HUP} = 'IGNORE';
4644   local $SIG{INT} = 'IGNORE';
4645   local $SIG{QUIT} = 'IGNORE';
4646   local $SIG{TERM} = 'IGNORE';
4647   local $SIG{TSTP} = 'IGNORE';
4648   local $SIG{PIPE} = 'IGNORE';
4649
4650   my $oldAutoCommit = $FS::UID::AutoCommit;
4651   local $FS::UID::AutoCommit = 0;
4652   my $dbh = dbh;
4653
4654   #while ( $columns = $csv->getline($fh) ) {
4655   my $line;
4656   while ( defined($line=<$fh>) ) {
4657
4658     $csv->parse($line) or do {
4659       $dbh->rollback if $oldAutoCommit;
4660       return "can't parse: ". $csv->error_input();
4661     };
4662
4663     my @columns = $csv->fields();
4664     #warn join('-',@columns);
4665
4666     my %row = ();
4667     foreach my $field ( @fields ) {
4668       $row{$field} = shift @columns;
4669     }
4670
4671     if ( $row{custnum} && $row{agent_custid} ) {
4672       dbh->rollback if $oldAutoCommit;
4673       return "can't specify custnum with agent_custid $row{agent_custid}";
4674     }
4675
4676     my %hash = ();
4677     if ( $row{agent_custid} && $agentnum ) {
4678       %hash = ( 'agent_custid' => $row{agent_custid},
4679                 'agentnum'     => $agentnum,
4680               );
4681     }
4682
4683     if ( $row{custnum} ) {
4684       %hash = ( 'custnum' => $row{custnum} );
4685     }
4686
4687     unless ( scalar(keys %hash) ) {
4688       $dbh->rollback if $oldAutoCommit;
4689       return "can't find customer without custnum or agent_custid and agentnum";
4690     }
4691
4692     my $cust_main = qsearchs('cust_main', { %hash } );
4693     unless ( $cust_main ) {
4694       $dbh->rollback if $oldAutoCommit;
4695       my $custnum = $row{custnum} || $row{agent_custid};
4696       return "unknown custnum $custnum";
4697     }
4698
4699     if ( $row{'amount'} > 0 ) {
4700       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4701       if ( $error ) {
4702         $dbh->rollback if $oldAutoCommit;
4703         return $error;
4704       }
4705       $imported++;
4706     } elsif ( $row{'amount'} < 0 ) {
4707       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4708                                       $row{'pkg'}                         );
4709       if ( $error ) {
4710         $dbh->rollback if $oldAutoCommit;
4711         return $error;
4712       }
4713       $imported++;
4714     } else {
4715       #hmm?
4716     }
4717
4718   }
4719
4720   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4721
4722   return "Empty file!" unless $imported;
4723
4724   ''; #no error
4725
4726 }
4727
4728 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4729
4730 Deprecated.  Use event notification and message templates
4731 (L<FS::msg_template>) instead.
4732
4733 Sends a templated email notification to the customer (see L<Text::Template>).
4734
4735 OPTIONS is a hash and may include
4736
4737 I<from> - the email sender (default is invoice_from)
4738
4739 I<to> - comma-separated scalar or arrayref of recipients
4740    (default is invoicing_list)
4741
4742 I<subject> - The subject line of the sent email notification
4743    (default is "Notice from company_name")
4744
4745 I<extra_fields> - a hashref of name/value pairs which will be substituted
4746    into the template
4747
4748 The following variables are vavailable in the template.
4749
4750 I<$first> - the customer first name
4751 I<$last> - the customer last name
4752 I<$company> - the customer company
4753 I<$payby> - a description of the method of payment for the customer
4754             # would be nice to use FS::payby::shortname
4755 I<$payinfo> - the account information used to collect for this customer
4756 I<$expdate> - the expiration of the customer payment in seconds from epoch
4757
4758 =cut
4759
4760 sub notify {
4761   my ($self, $template, %options) = @_;
4762
4763   return unless $conf->exists($template);
4764
4765   my $from = $conf->config('invoice_from', $self->agentnum)
4766     if $conf->exists('invoice_from', $self->agentnum);
4767   $from = $options{from} if exists($options{from});
4768
4769   my $to = join(',', $self->invoicing_list_emailonly);
4770   $to = $options{to} if exists($options{to});
4771
4772   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4773     if $conf->exists('company_name', $self->agentnum);
4774   $subject = $options{subject} if exists($options{subject});
4775
4776   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4777                                             SOURCE => [ map "$_\n",
4778                                               $conf->config($template)]
4779                                            )
4780     or die "can't create new Text::Template object: Text::Template::ERROR";
4781   $notify_template->compile()
4782     or die "can't compile template: Text::Template::ERROR";
4783
4784   $FS::notify_template::_template::company_name =
4785     $conf->config('company_name', $self->agentnum);
4786   $FS::notify_template::_template::company_address =
4787     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4788
4789   my $paydate = $self->paydate || '2037-12-31';
4790   $FS::notify_template::_template::first = $self->first;
4791   $FS::notify_template::_template::last = $self->last;
4792   $FS::notify_template::_template::company = $self->company;
4793   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4794   my $payby = $self->payby;
4795   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4796   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4797
4798   #credit cards expire at the end of the month/year of their exp date
4799   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4800     $FS::notify_template::_template::payby = 'credit card';
4801     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4802     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4803     $expire_time--;
4804   }elsif ($payby eq 'COMP') {
4805     $FS::notify_template::_template::payby = 'complimentary account';
4806   }else{
4807     $FS::notify_template::_template::payby = 'current method';
4808   }
4809   $FS::notify_template::_template::expdate = $expire_time;
4810
4811   for (keys %{$options{extra_fields}}){
4812     no strict "refs";
4813     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4814   }
4815
4816   send_email(from => $from,
4817              to => $to,
4818              subject => $subject,
4819              body => $notify_template->fill_in( PACKAGE =>
4820                                                 'FS::notify_template::_template'                                              ),
4821             );
4822
4823 }
4824
4825 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4826
4827 Generates a templated notification to the customer (see L<Text::Template>).
4828
4829 OPTIONS is a hash and may include
4830
4831 I<extra_fields> - a hashref of name/value pairs which will be substituted
4832    into the template.  These values may override values mentioned below
4833    and those from the customer record.
4834
4835 The following variables are available in the template instead of or in addition
4836 to the fields of the customer record.
4837
4838 I<$payby> - a description of the method of payment for the customer
4839             # would be nice to use FS::payby::shortname
4840 I<$payinfo> - the masked account information used to collect for this customer
4841 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4842 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4843
4844 =cut
4845
4846 # a lot like cust_bill::print_latex
4847 sub generate_letter {
4848   my ($self, $template, %options) = @_;
4849
4850   return unless $conf->exists($template);
4851
4852   my $letter_template = new Text::Template
4853                         ( TYPE       => 'ARRAY',
4854                           SOURCE     => [ map "$_\n", $conf->config($template)],
4855                           DELIMITERS => [ '[@--', '--@]' ],
4856                         )
4857     or die "can't create new Text::Template object: Text::Template::ERROR";
4858
4859   $letter_template->compile()
4860     or die "can't compile template: Text::Template::ERROR";
4861
4862   my %letter_data = map { $_ => $self->$_ } $self->fields;
4863   $letter_data{payinfo} = $self->mask_payinfo;
4864
4865   #my $paydate = $self->paydate || '2037-12-31';
4866   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4867
4868   my $payby = $self->payby;
4869   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4870   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4871
4872   #credit cards expire at the end of the month/year of their exp date
4873   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4874     $letter_data{payby} = 'credit card';
4875     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4876     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4877     $expire_time--;
4878   }elsif ($payby eq 'COMP') {
4879     $letter_data{payby} = 'complimentary account';
4880   }else{
4881     $letter_data{payby} = 'current method';
4882   }
4883   $letter_data{expdate} = $expire_time;
4884
4885   for (keys %{$options{extra_fields}}){
4886     $letter_data{$_} = $options{extra_fields}->{$_};
4887   }
4888
4889   unless(exists($letter_data{returnaddress})){
4890     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4891                                                   $self->agent_template)
4892                      );
4893     if ( length($retadd) ) {
4894       $letter_data{returnaddress} = $retadd;
4895     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4896       $letter_data{returnaddress} =
4897         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4898                           s/$/\\\\\*/;
4899                           $_;
4900                         }
4901                     ( $conf->config('company_name', $self->agentnum),
4902                       $conf->config('company_address', $self->agentnum),
4903                     )
4904         );
4905     } else {
4906       $letter_data{returnaddress} = '~';
4907     }
4908   }
4909
4910   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4911
4912   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4913
4914   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4915
4916   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4917                            DIR      => $dir,
4918                            SUFFIX   => '.eps',
4919                            UNLINK   => 0,
4920                          ) or die "can't open temp file: $!\n";
4921   print $lh $conf->config_binary('logo.eps', $self->agentnum)
4922     or die "can't write temp file: $!\n";
4923   close $lh;
4924   $letter_data{'logo_file'} = $lh->filename;
4925
4926   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4927                            DIR      => $dir,
4928                            SUFFIX   => '.tex',
4929                            UNLINK   => 0,
4930                          ) or die "can't open temp file: $!\n";
4931
4932   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4933   close $fh;
4934   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4935   return ($1, $letter_data{'logo_file'});
4936
4937 }
4938
4939 =item print_ps TEMPLATE
4940
4941 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4942
4943 =cut
4944
4945 sub print_ps {
4946   my $self = shift;
4947   my($file, $lfile) = $self->generate_letter(@_);
4948   my $ps = FS::Misc::generate_ps($file);
4949   unlink($file.'.tex');
4950   unlink($lfile);
4951
4952   $ps;
4953 }
4954
4955 =item print TEMPLATE
4956
4957 Prints the filled in template.
4958
4959 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4960
4961 =cut
4962
4963 sub queueable_print {
4964   my %opt = @_;
4965
4966   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4967     or die "invalid customer number: " . $opt{custnum};
4968
4969   my $error = $self->print( { 'template' => $opt{template} } );
4970   die $error if $error;
4971 }
4972
4973 sub print {
4974   my ($self, $template) = (shift, shift);
4975   do_print(
4976     [ $self->print_ps($template) ],
4977     'agentnum' => $self->agentnum,
4978   );
4979 }
4980
4981 #these three subs should just go away once agent stuff is all config overrides
4982
4983 sub agent_template {
4984   my $self = shift;
4985   $self->_agent_plandata('agent_templatename');
4986 }
4987
4988 sub agent_invoice_from {
4989   my $self = shift;
4990   $self->_agent_plandata('agent_invoice_from');
4991 }
4992
4993 sub _agent_plandata {
4994   my( $self, $option ) = @_;
4995
4996   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
4997   #agent-specific Conf
4998
4999   use FS::part_event::Condition;
5000
5001   my $agentnum = $self->agentnum;
5002
5003   my $regexp = regexp_sql();
5004
5005   my $part_event_option =
5006     qsearchs({
5007       'select'    => 'part_event_option.*',
5008       'table'     => 'part_event_option',
5009       'addl_from' => q{
5010         LEFT JOIN part_event USING ( eventpart )
5011         LEFT JOIN part_event_option AS peo_agentnum
5012           ON ( part_event.eventpart = peo_agentnum.eventpart
5013                AND peo_agentnum.optionname = 'agentnum'
5014                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5015              )
5016         LEFT JOIN part_event_condition
5017           ON ( part_event.eventpart = part_event_condition.eventpart
5018                AND part_event_condition.conditionname = 'cust_bill_age'
5019              )
5020         LEFT JOIN part_event_condition_option
5021           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5022                AND part_event_condition_option.optionname = 'age'
5023              )
5024       },
5025       #'hashref'   => { 'optionname' => $option },
5026       #'hashref'   => { 'part_event_option.optionname' => $option },
5027       'extra_sql' =>
5028         " WHERE part_event_option.optionname = ". dbh->quote($option).
5029         " AND action = 'cust_bill_send_agent' ".
5030         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5031         " AND peo_agentnum.optionname = 'agentnum' ".
5032         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5033         " ORDER BY
5034            CASE WHEN part_event_condition_option.optionname IS NULL
5035            THEN -1
5036            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5037         " END
5038           , part_event.weight".
5039         " LIMIT 1"
5040     });
5041
5042   unless ( $part_event_option ) {
5043     return $self->agent->invoice_template || ''
5044       if $option eq 'agent_templatename';
5045     return '';
5046   }
5047
5048   $part_event_option->optionvalue;
5049
5050 }
5051
5052 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5053
5054 Subroutine (not a method), designed to be called from the queue.
5055
5056 Takes a list of options and values.
5057
5058 Pulls up the customer record via the custnum option and calls bill_and_collect.
5059
5060 =cut
5061
5062 sub queued_bill {
5063   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5064
5065   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5066   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5067
5068   #without this errors don't get rolled back
5069   $args{'fatal'} = 1; # runs from job queue, will be caught
5070
5071   $cust_main->bill_and_collect( %args );
5072 }
5073
5074 sub process_bill_and_collect {
5075   my $job = shift;
5076   my $param = thaw(decode_base64(shift));
5077   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5078       or die "custnum '$param->{custnum}' not found!\n";
5079   $param->{'job'}   = $job;
5080   $param->{'fatal'} = 1; # runs from job queue, will be caught
5081   $param->{'retry'} = 1;
5082
5083   $cust_main->bill_and_collect( %$param );
5084 }
5085
5086 #starting to take quite a while for big dbs
5087 #   (JRNL: journaled so it only happens once per database)
5088 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5089 # JRNL seq scan of cust_main on signupdate... index signupdate?  will that help?
5090 # JRNL seq scan of cust_main on paydate... index on substrings?  maybe set an
5091 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5092 # JRNL leading/trailing spaces in first, last, company
5093 # - otaker upgrade?  journal and call it good?  (double check to make sure
5094 #    we're not still setting otaker here)
5095 #
5096 #only going to get worse with new location stuff...
5097
5098 sub _upgrade_data { #class method
5099   my ($class, %opts) = @_;
5100
5101   my @statements = (
5102     'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5103   );
5104
5105   #this seems to be the only expensive one.. why does it take so long?
5106   unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5107     push @statements,
5108       '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';
5109     FS::upgrade_journal->set_done('cust_main__signupdate');
5110   }
5111
5112   unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5113
5114     # fix yyyy-m-dd formatted paydates
5115     if ( driver_name =~ /^mysql/i ) {
5116       push @statements,
5117       "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5118     } else { # the SQL standard
5119       push @statements,
5120       "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5121     }
5122     FS::upgrade_journal->set_done('cust_main__paydate');
5123   }
5124
5125   unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5126
5127     push @statements, #fix the weird BILL with a cc# in payinfo problem
5128       #DCRD to be safe
5129       "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5130
5131     FS::upgrade_journal->set_done('cust_main__payinfo');
5132
5133   }
5134
5135   my $t = time;
5136   foreach my $sql ( @statements ) {
5137     my $sth = dbh->prepare($sql) or die dbh->errstr;
5138     $sth->execute or die $sth->errstr;
5139     #warn ( (time - $t). " seconds\n" );
5140     #$t = time;
5141   }
5142
5143   local($ignore_expired_card) = 1;
5144   local($ignore_banned_card) = 1;
5145   local($skip_fuzzyfiles) = 1;
5146   local($import) = 1; #prevent automatic geocoding (need its own variable?)
5147
5148   FS::cust_main::Location->_upgrade_data(%opts);
5149
5150   unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5151
5152     foreach my $cust_main ( qsearch({
5153       'table'     => 'cust_main',
5154       'hashref'   => {},
5155       'extra_sql' => 'WHERE '.
5156                        join(' OR ',
5157                          map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '%  %'",
5158                            qw( first last company )
5159                        ),
5160     }) ) {
5161       my $error = $cust_main->replace;
5162       die $error if $error;
5163     }
5164
5165     FS::upgrade_journal->set_done('cust_main__trimspaces');
5166
5167   }
5168
5169   $class->_upgrade_otaker(%opts);
5170
5171 }
5172
5173 =back
5174
5175 =head1 BUGS
5176
5177 The delete method.
5178
5179 The delete method should possibly take an FS::cust_main object reference
5180 instead of a scalar customer number.
5181
5182 Bill and collect options should probably be passed as references instead of a
5183 list.
5184
5185 There should probably be a configuration file with a list of allowed credit
5186 card types.
5187
5188 No multiple currency support (probably a larger project than just this module).
5189
5190 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5191
5192 Birthdates rely on negative epoch values.
5193
5194 The payby for card/check batches is broken.  With mixed batching, bad
5195 things will happen.
5196
5197 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5198
5199 =head1 SEE ALSO
5200
5201 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5202 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5203 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5204
5205 =cut
5206
5207 1;
5208