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_snumbern('spouse_birthdate')
1760     || $self->ut_snumbern('anniversary_date')
1761     || $self->ut_textn('company')
1762     || $self->ut_textn('ship_company')
1763     || $self->ut_anything('comments')
1764     || $self->ut_numbern('referral_custnum')
1765     || $self->ut_textn('stateid')
1766     || $self->ut_textn('stateid_state')
1767     || $self->ut_textn('invoice_terms')
1768     || $self->ut_floatn('cdr_termination_percentage')
1769     || $self->ut_floatn('credit_limit')
1770     || $self->ut_numbern('billday')
1771     || $self->ut_numbern('prorate_day')
1772     || $self->ut_flag('edit_subject')
1773     || $self->ut_flag('calling_list_exempt')
1774     || $self->ut_flag('invoice_noemail')
1775     || $self->ut_flag('message_noemail')
1776     || $self->ut_enum('locale', [ '', FS::Locales->locales ])
1777   ;
1778
1779   foreach (qw(company ship_company)) {
1780     my $company = $self->get($_);
1781     $company =~ s/^\s+//;
1782     $company =~ s/\s+$//;
1783     $company =~ s/\s+/ /g;
1784     $self->set($_, $company);
1785   }
1786
1787   #barf.  need message catalogs.  i18n.  etc.
1788   $error .= "Please select an advertising source."
1789     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1790   return $error if $error;
1791
1792   return "Unknown agent"
1793     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1794
1795   return "Unknown refnum"
1796     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1797
1798   return "Unknown referring custnum: ". $self->referral_custnum
1799     unless ! $self->referral_custnum
1800            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1801
1802   if ( $self->ss eq '' ) {
1803     $self->ss('');
1804   } else {
1805     my $ss = $self->ss;
1806     $ss =~ s/\D//g;
1807     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1808       or return "Illegal social security number: ". $self->ss;
1809     $self->ss("$1-$2-$3");
1810   }
1811
1812   # cust_main_county verification now handled by cust_location check
1813
1814   $error =
1815        $self->ut_phonen('daytime', $self->country)
1816     || $self->ut_phonen('night',   $self->country)
1817     || $self->ut_phonen('fax',     $self->country)
1818     || $self->ut_phonen('mobile',  $self->country)
1819   ;
1820   return $error if $error;
1821
1822   if ( $conf->exists('cust_main-require_phone', $self->agentnum)
1823        && ! $import
1824        && ! length($self->daytime) && ! length($self->night) && ! length($self->mobile)
1825      ) {
1826
1827     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1828                           ? 'Day Phone'
1829                           : FS::Msgcat::_gettext('daytime');
1830     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1831                         ? 'Night Phone'
1832                         : FS::Msgcat::_gettext('night');
1833
1834     my $mobile_label = FS::Msgcat::_gettext('mobile') =~ /^(mobile)?$/
1835                         ? 'Mobile Phone'
1836                         : FS::Msgcat::_gettext('mobile');
1837
1838     return "$daytime_label, $night_label or $mobile_label is required"
1839
1840   }
1841
1842   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1843   #  or return "Illegal payby: ". $self->payby;
1844   #$self->payby($1);
1845   FS::payby->can_payby($self->table, $self->payby)
1846     or return "Illegal payby: ". $self->payby;
1847
1848   $error =    $self->ut_numbern('paystart_month')
1849            || $self->ut_numbern('paystart_year')
1850            || $self->ut_numbern('payissue')
1851            || $self->ut_textn('paytype')
1852   ;
1853   return $error if $error;
1854
1855   if ( $self->payip eq '' ) {
1856     $self->payip('');
1857   } else {
1858     $error = $self->ut_ip('payip');
1859     return $error if $error;
1860   }
1861
1862   # If it is encrypted and the private key is not availaible then we can't
1863   # check the credit card.
1864   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1865
1866   # Need some kind of global flag to accept invalid cards, for testing
1867   # on scrubbed data.
1868   if ( !$import && $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1869
1870     my $payinfo = $self->payinfo;
1871     $payinfo =~ s/\D//g;
1872     $payinfo =~ /^(\d{13,16}|\d{8,9})$/
1873       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1874     $payinfo = $1;
1875     $self->payinfo($payinfo);
1876     validate($payinfo)
1877       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1878
1879     return gettext('unknown_card_type')
1880       if $self->payinfo !~ /^99\d{14}$/ #token
1881       && cardtype($self->payinfo) eq "Unknown";
1882
1883     unless ( $ignore_banned_card ) {
1884       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1885       if ( $ban ) {
1886         if ( $ban->bantype eq 'warn' ) {
1887           #or others depending on value of $ban->reason ?
1888           return '_duplicate_card'.
1889                  ': disabled from'. time2str('%a %h %o at %r', $ban->_date).
1890                  ' until '.         time2str('%a %h %o at %r', $ban->_end_date).
1891                  ' (ban# '. $ban->bannum. ')'
1892             unless $self->override_ban_warn;
1893         } else {
1894           return 'Banned credit card: banned on '.
1895                  time2str('%a %h %o at %r', $ban->_date).
1896                  ' by '. $ban->otaker.
1897                  ' (ban# '. $ban->bannum. ')';
1898         }
1899       }
1900     }
1901
1902     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1903       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1904         $self->paycvv =~ /^(\d{4})$/
1905           or return "CVV2 (CID) for American Express cards is four digits.";
1906         $self->paycvv($1);
1907       } else {
1908         $self->paycvv =~ /^(\d{3})$/
1909           or return "CVV2 (CVC2/CID) is three digits.";
1910         $self->paycvv($1);
1911       }
1912     } else {
1913       $self->paycvv('');
1914     }
1915
1916     my $cardtype = cardtype($payinfo);
1917     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1918
1919       return "Start date or issue number is required for $cardtype cards"
1920         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1921
1922       return "Start month must be between 1 and 12"
1923         if $self->paystart_month
1924            and $self->paystart_month < 1 || $self->paystart_month > 12;
1925
1926       return "Start year must be 1990 or later"
1927         if $self->paystart_year
1928            and $self->paystart_year < 1990;
1929
1930       return "Issue number must be beween 1 and 99"
1931         if $self->payissue
1932           and $self->payissue < 1 || $self->payissue > 99;
1933
1934     } else {
1935       $self->paystart_month('');
1936       $self->paystart_year('');
1937       $self->payissue('');
1938     }
1939
1940   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1941
1942     my $payinfo = $self->payinfo;
1943     $payinfo =~ s/[^\d\@\.]//g;
1944     if ( $conf->config('echeck-country') eq 'CA' ) {
1945       $payinfo =~ /^(\d+)\@(\d{5})\.(\d{3})$/
1946         or return 'invalid echeck account@branch.bank';
1947       $payinfo = "$1\@$2.$3";
1948     } elsif ( $conf->config('echeck-country') eq 'US' ) {
1949       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1950       $payinfo = "$1\@$2";
1951     } else {
1952       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@routing';
1953       $payinfo = "$1\@$2";
1954     }
1955     $self->payinfo($payinfo);
1956     $self->paycvv('');
1957
1958     unless ( $ignore_banned_card ) {
1959       my $ban = FS::banned_pay->ban_search( %{ $self->_banned_pay_hashref } );
1960       if ( $ban ) {
1961         if ( $ban->bantype eq 'warn' ) {
1962           #or others depending on value of $ban->reason ?
1963           return '_duplicate_ach' unless $self->override_ban_warn;
1964         } else {
1965           return 'Banned ACH account: banned on '.
1966                  time2str('%a %h %o at %r', $ban->_date).
1967                  ' by '. $ban->otaker.
1968                  ' (ban# '. $ban->bannum. ')';
1969         }
1970       }
1971     }
1972
1973   } elsif ( $self->payby eq 'LECB' ) {
1974
1975     my $payinfo = $self->payinfo;
1976     $payinfo =~ s/\D//g;
1977     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1978     $payinfo = $1;
1979     $self->payinfo($payinfo);
1980     $self->paycvv('');
1981
1982   } elsif ( $self->payby eq 'BILL' ) {
1983
1984     $error = $self->ut_textn('payinfo');
1985     return "Illegal P.O. number: ". $self->payinfo if $error;
1986     $self->paycvv('');
1987
1988   } elsif ( $self->payby eq 'COMP' ) {
1989
1990     my $curuser = $FS::CurrentUser::CurrentUser;
1991     if (    ! $self->custnum
1992          && ! $curuser->access_right('Complimentary customer')
1993        )
1994     {
1995       return "You are not permitted to create complimentary accounts."
1996     }
1997
1998     $error = $self->ut_textn('payinfo');
1999     return "Illegal comp account issuer: ". $self->payinfo if $error;
2000     $self->paycvv('');
2001
2002   } elsif ( $self->payby eq 'PREPAY' ) {
2003
2004     my $payinfo = $self->payinfo;
2005     $payinfo =~ s/\W//g; #anything else would just confuse things
2006     $self->payinfo($payinfo);
2007     $error = $self->ut_alpha('payinfo');
2008     return "Illegal prepayment identifier: ". $self->payinfo if $error;
2009     return "Unknown prepayment identifier"
2010       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2011     $self->paycvv('');
2012
2013   }
2014
2015   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2016     return "Expiration date required"
2017       # shouldn't payinfo_check do this?
2018       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD|PPAL)$/;
2019     $self->paydate('');
2020   } else {
2021     my( $m, $y );
2022     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2023       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2024     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2025       ( $m, $y ) = ( $2, "19$1" );
2026     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2027       ( $m, $y ) = ( $3, "20$2" );
2028     } else {
2029       return "Illegal expiration date: ". $self->paydate;
2030     }
2031     $m = sprintf('%02d',$m);
2032     $self->paydate("$y-$m-01");
2033     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2034     return gettext('expired_card')
2035       if !$import
2036       && !$ignore_expired_card
2037       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2038   }
2039
2040   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2041        ( ! $conf->exists('require_cardname')
2042          || $self->payby !~ /^(CARD|DCRD)$/  )
2043   ) {
2044     $self->payname( $self->first. " ". $self->getfield('last') );
2045   } else {
2046
2047     if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2048       $self->payname =~ /^([\w \,\.\-\']*)$/
2049         or return gettext('illegal_name'). " payname: ". $self->payname;
2050       $self->payname($1);
2051     } else {
2052       $self->payname =~ /^([\w \,\.\-\'\&]*)$/
2053         or return gettext('illegal_name'). " payname: ". $self->payname;
2054       $self->payname($1);
2055     }
2056
2057   }
2058
2059   return "Please select an invoicing locale"
2060     if ! $self->locale
2061     && ! $self->custnum
2062     && $conf->exists('cust_main-require_locale');
2063
2064   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2065     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2066     $self->$flag($1);
2067   }
2068
2069   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2070
2071   warn "$me check AFTER: \n". $self->_dump
2072     if $DEBUG > 2;
2073
2074   $self->SUPER::check;
2075 }
2076
2077 =item addr_fields
2078
2079 Returns a list of fields which have ship_ duplicates.
2080
2081 =cut
2082
2083 sub addr_fields {
2084   qw( last first company
2085       address1 address2 city county state zip country
2086       latitude longitude
2087       daytime night fax mobile
2088     );
2089 }
2090
2091 =item has_ship_address
2092
2093 Returns true if this customer record has a separate shipping address.
2094
2095 =cut
2096
2097 sub has_ship_address {
2098   my $self = shift;
2099   $self->bill_locationnum != $self->ship_locationnum;
2100 }
2101
2102 =item location_hash
2103
2104 Returns a list of key/value pairs, with the following keys: address1,
2105 adddress2, city, county, state, zip, country, district, and geocode.  The
2106 shipping address is used if present.
2107
2108 =cut
2109
2110 sub location_hash {
2111   my $self = shift;
2112   $self->ship_location->location_hash;
2113 }
2114
2115 =item cust_location
2116
2117 Returns all locations (see L<FS::cust_location>) for this customer.
2118
2119 =cut
2120
2121 sub cust_location {
2122   my $self = shift;
2123   qsearch('cust_location', { 'custnum' => $self->custnum,
2124                              'prospectnum' => '' } );
2125 }
2126
2127 =item cust_contact
2128
2129 Returns all contacts (see L<FS::contact>) for this customer.
2130
2131 =cut
2132
2133 #already used :/ sub contact {
2134 sub cust_contact {
2135   my $self = shift;
2136   qsearch('contact', { 'custnum' => $self->custnum } );
2137 }
2138
2139 =item unsuspend
2140
2141 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2142 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
2143 on success or a list of errors.
2144
2145 =cut
2146
2147 sub unsuspend {
2148   my $self = shift;
2149   grep { $_->unsuspend } $self->suspended_pkgs;
2150 }
2151
2152 =item suspend
2153
2154 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2155
2156 Returns a list: an empty list on success or a list of errors.
2157
2158 =cut
2159
2160 sub suspend {
2161   my $self = shift;
2162   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2163 }
2164
2165 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2166
2167 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2168 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2169 of a list of pkgparts; the hashref has the following keys:
2170
2171 =over 4
2172
2173 =item pkgparts - listref of pkgparts
2174
2175 =item (other options are passed to the suspend method)
2176
2177 =back
2178
2179
2180 Returns a list: an empty list on success or a list of errors.
2181
2182 =cut
2183
2184 sub suspend_if_pkgpart {
2185   my $self = shift;
2186   my (@pkgparts, %opt);
2187   if (ref($_[0]) eq 'HASH'){
2188     @pkgparts = @{$_[0]{pkgparts}};
2189     %opt      = %{$_[0]};
2190   }else{
2191     @pkgparts = @_;
2192   }
2193   grep { $_->suspend(%opt) }
2194     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2195       $self->unsuspended_pkgs;
2196 }
2197
2198 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2199
2200 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2201 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2202 instead of a list of pkgparts; the hashref has the following keys:
2203
2204 =over 4
2205
2206 =item pkgparts - listref of pkgparts
2207
2208 =item (other options are passed to the suspend method)
2209
2210 =back
2211
2212 Returns a list: an empty list on success or a list of errors.
2213
2214 =cut
2215
2216 sub suspend_unless_pkgpart {
2217   my $self = shift;
2218   my (@pkgparts, %opt);
2219   if (ref($_[0]) eq 'HASH'){
2220     @pkgparts = @{$_[0]{pkgparts}};
2221     %opt      = %{$_[0]};
2222   }else{
2223     @pkgparts = @_;
2224   }
2225   grep { $_->suspend(%opt) }
2226     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2227       $self->unsuspended_pkgs;
2228 }
2229
2230 =item cancel [ OPTION => VALUE ... ]
2231
2232 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2233
2234 Available options are:
2235
2236 =over 4
2237
2238 =item quiet - can be set true to supress email cancellation notices.
2239
2240 =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.
2241
2242 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2243
2244 =item nobill - can be set true to skip billing if it might otherwise be done.
2245
2246 =back
2247
2248 Always returns a list: an empty list on success or a list of errors.
2249
2250 =cut
2251
2252 # nb that dates are not specified as valid options to this method
2253
2254 sub cancel {
2255   my( $self, %opt ) = @_;
2256
2257   warn "$me cancel called on customer ". $self->custnum. " with options ".
2258        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2259     if $DEBUG;
2260
2261   return ( 'access denied' )
2262     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2263
2264   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2265
2266     #should try decryption (we might have the private key)
2267     # and if not maybe queue a job for the server that does?
2268     return ( "Can't (yet) ban encrypted credit cards" )
2269       if $self->is_encrypted($self->payinfo);
2270
2271     my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2272     my $error = $ban->insert;
2273     return ( $error ) if $error;
2274
2275   }
2276
2277   my @pkgs = $self->ncancelled_pkgs;
2278
2279   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2280     $opt{nobill} = 1;
2281     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2282     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2283       if $error;
2284   }
2285
2286   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2287        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2288     if $DEBUG;
2289
2290   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2291 }
2292
2293 sub _banned_pay_hashref {
2294   my $self = shift;
2295
2296   my %payby2ban = (
2297     'CARD' => 'CARD',
2298     'DCRD' => 'CARD',
2299     'CHEK' => 'CHEK',
2300     'DCHK' => 'CHEK'
2301   );
2302
2303   {
2304     'payby'   => $payby2ban{$self->payby},
2305     'payinfo' => $self->payinfo,
2306     #don't ever *search* on reason! #'reason'  =>
2307   };
2308 }
2309
2310 sub _new_banned_pay_hashref {
2311   my $self = shift;
2312   my $hr = $self->_banned_pay_hashref;
2313   $hr->{payinfo} = md5_base64($hr->{payinfo});
2314   $hr;
2315 }
2316
2317 =item notes
2318
2319 Returns all notes (see L<FS::cust_main_note>) for this customer.
2320
2321 =cut
2322
2323 sub notes {
2324   my($self,$orderby_classnum) = (shift,shift);
2325   my $orderby = "_DATE DESC";
2326   $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum;
2327   qsearch( 'cust_main_note',
2328            { 'custnum' => $self->custnum },
2329            '',
2330            "ORDER BY $orderby",
2331          );
2332 }
2333
2334 =item agent
2335
2336 Returns the agent (see L<FS::agent>) for this customer.
2337
2338 =cut
2339
2340 sub agent {
2341   my $self = shift;
2342   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2343 }
2344
2345 =item agent_name
2346
2347 Returns the agent name (see L<FS::agent>) for this customer.
2348
2349 =cut
2350
2351 sub agent_name {
2352   my $self = shift;
2353   $self->agent->agent;
2354 }
2355
2356 =item cust_tag
2357
2358 Returns any tags associated with this customer, as FS::cust_tag objects,
2359 or an empty list if there are no tags.
2360
2361 =cut
2362
2363 sub cust_tag {
2364   my $self = shift;
2365   qsearch('cust_tag', { 'custnum' => $self->custnum } );
2366 }
2367
2368 =item part_tag
2369
2370 Returns any tags associated with this customer, as FS::part_tag objects,
2371 or an empty list if there are no tags.
2372
2373 =cut
2374
2375 sub part_tag {
2376   my $self = shift;
2377   map $_->part_tag, $self->cust_tag;
2378 }
2379
2380
2381 =item cust_class
2382
2383 Returns the customer class, as an FS::cust_class object, or the empty string
2384 if there is no customer class.
2385
2386 =cut
2387
2388 sub cust_class {
2389   my $self = shift;
2390   if ( $self->classnum ) {
2391     qsearchs('cust_class', { 'classnum' => $self->classnum } );
2392   } else {
2393     return '';
2394   }
2395 }
2396
2397 =item categoryname
2398
2399 Returns the customer category name, or the empty string if there is no customer
2400 category.
2401
2402 =cut
2403
2404 sub categoryname {
2405   my $self = shift;
2406   my $cust_class = $self->cust_class;
2407   $cust_class
2408     ? $cust_class->categoryname
2409     : '';
2410 }
2411
2412 =item classname
2413
2414 Returns the customer class name, or the empty string if there is no customer
2415 class.
2416
2417 =cut
2418
2419 sub classname {
2420   my $self = shift;
2421   my $cust_class = $self->cust_class;
2422   $cust_class
2423     ? $cust_class->classname
2424     : '';
2425 }
2426
2427 =item BILLING METHODS
2428
2429 Documentation on billing methods has been moved to
2430 L<FS::cust_main::Billing>.
2431
2432 =item REALTIME BILLING METHODS
2433
2434 Documentation on realtime billing methods has been moved to
2435 L<FS::cust_main::Billing_Realtime>.
2436
2437 =item remove_cvv
2438
2439 Removes the I<paycvv> field from the database directly.
2440
2441 If there is an error, returns the error, otherwise returns false.
2442
2443 =cut
2444
2445 sub remove_cvv {
2446   my $self = shift;
2447   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2448     or return dbh->errstr;
2449   $sth->execute($self->custnum)
2450     or return $sth->errstr;
2451   $self->paycvv('');
2452   '';
2453 }
2454
2455 =item batch_card OPTION => VALUE...
2456
2457 Adds a payment for this invoice to the pending credit card batch (see
2458 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2459 runs the payment using a realtime gateway.
2460
2461 Options may include:
2462
2463 B<amount>: the amount to be paid; defaults to the customer's balance minus
2464 any payments in transit.
2465
2466 B<payby>: the payment method; defaults to cust_main.payby
2467
2468 B<realtime>: runs this as a realtime payment instead of adding it to a
2469 batch.  Deprecated.
2470
2471 B<invnum>: sets cust_pay_batch.invnum.
2472
2473 B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets
2474 the billing address for the payment; defaults to the customer's billing
2475 location.
2476
2477 B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
2478 date, and name; defaults to those fields in cust_main.
2479
2480 =cut
2481
2482 sub batch_card {
2483   my ($self, %options) = @_;
2484
2485   my $amount;
2486   if (exists($options{amount})) {
2487     $amount = $options{amount};
2488   }else{
2489     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2490   }
2491   return '' unless $amount > 0;
2492
2493   my $invnum = delete $options{invnum};
2494   my $payby = $options{payby} || $self->payby;  #still dubious
2495
2496   if ($options{'realtime'}) {
2497     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2498                                 $amount,
2499                                 %options,
2500                               );
2501   }
2502
2503   my $oldAutoCommit = $FS::UID::AutoCommit;
2504   local $FS::UID::AutoCommit = 0;
2505   my $dbh = dbh;
2506
2507   #this needs to handle mysql as well as Pg, like svc_acct.pm
2508   #(make it into a common function if folks need to do batching with mysql)
2509   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2510     or return "Cannot lock pay_batch: " . $dbh->errstr;
2511
2512   my %pay_batch = (
2513     'status' => 'O',
2514     'payby'  => FS::payby->payby2payment($payby),
2515   );
2516   $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2517
2518   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2519
2520   unless ( $pay_batch ) {
2521     $pay_batch = new FS::pay_batch \%pay_batch;
2522     my $error = $pay_batch->insert;
2523     if ( $error ) {
2524       $dbh->rollback if $oldAutoCommit;
2525       die "error creating new batch: $error\n";
2526     }
2527   }
2528
2529   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2530       'batchnum' => $pay_batch->batchnum,
2531       'custnum'  => $self->custnum,
2532   } );
2533
2534   foreach (qw( address1 address2 city state zip country latitude longitude
2535                payby payinfo paydate payname ))
2536   {
2537     $options{$_} = '' unless exists($options{$_});
2538   }
2539
2540   my $loc = $self->bill_location;
2541
2542   my $cust_pay_batch = new FS::cust_pay_batch ( {
2543     'batchnum' => $pay_batch->batchnum,
2544     'invnum'   => $invnum || 0,                    # is there a better value?
2545                                                    # this field should be
2546                                                    # removed...
2547                                                    # cust_bill_pay_batch now
2548     'custnum'  => $self->custnum,
2549     'last'     => $self->getfield('last'),
2550     'first'    => $self->getfield('first'),
2551     'address1' => $options{address1} || $loc->address1,
2552     'address2' => $options{address2} || $loc->address2,
2553     'city'     => $options{city}     || $loc->city,
2554     'state'    => $options{state}    || $loc->state,
2555     'zip'      => $options{zip}      || $loc->zip,
2556     'country'  => $options{country}  || $loc->country,
2557     'payby'    => $options{payby}    || $self->payby,
2558     'payinfo'  => $options{payinfo}  || $self->payinfo,
2559     'exp'      => $options{paydate}  || $self->paydate,
2560     'payname'  => $options{payname}  || $self->payname,
2561     'amount'   => $amount,                         # consolidating
2562   } );
2563
2564   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2565     if $old_cust_pay_batch;
2566
2567   my $error;
2568   if ($old_cust_pay_batch) {
2569     $error = $cust_pay_batch->replace($old_cust_pay_batch)
2570   } else {
2571     $error = $cust_pay_batch->insert;
2572   }
2573
2574   if ( $error ) {
2575     $dbh->rollback if $oldAutoCommit;
2576     die $error;
2577   }
2578
2579   my $unapplied =   $self->total_unapplied_credits
2580                   + $self->total_unapplied_payments
2581                   + $self->in_transit_payments;
2582   foreach my $cust_bill ($self->open_cust_bill) {
2583     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2584     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2585       'invnum' => $cust_bill->invnum,
2586       'paybatchnum' => $cust_pay_batch->paybatchnum,
2587       'amount' => $cust_bill->owed,
2588       '_date' => time,
2589     };
2590     if ($unapplied >= $cust_bill_pay_batch->amount){
2591       $unapplied -= $cust_bill_pay_batch->amount;
2592       next;
2593     }else{
2594       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2595                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
2596     }
2597     $error = $cust_bill_pay_batch->insert;
2598     if ( $error ) {
2599       $dbh->rollback if $oldAutoCommit;
2600       die $error;
2601     }
2602   }
2603
2604   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2605   '';
2606 }
2607
2608 =item total_owed
2609
2610 Returns the total owed for this customer on all invoices
2611 (see L<FS::cust_bill/owed>).
2612
2613 =cut
2614
2615 sub total_owed {
2616   my $self = shift;
2617   $self->total_owed_date(2145859200); #12/31/2037
2618 }
2619
2620 =item total_owed_date TIME
2621
2622 Returns the total owed for this customer on all invoices with date earlier than
2623 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2624 see L<Time::Local> and L<Date::Parse> for conversion functions.
2625
2626 =cut
2627
2628 sub total_owed_date {
2629   my $self = shift;
2630   my $time = shift;
2631
2632   my $custnum = $self->custnum;
2633
2634   my $owed_sql = FS::cust_bill->owed_sql;
2635
2636   my $sql = "
2637     SELECT SUM($owed_sql) FROM cust_bill
2638       WHERE custnum = $custnum
2639         AND _date <= $time
2640   ";
2641
2642   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2643
2644 }
2645
2646 =item total_owed_pkgnum PKGNUM
2647
2648 Returns the total owed on all invoices for this customer's specific package
2649 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2650
2651 =cut
2652
2653 sub total_owed_pkgnum {
2654   my( $self, $pkgnum ) = @_;
2655   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2656 }
2657
2658 =item total_owed_date_pkgnum TIME PKGNUM
2659
2660 Returns the total owed for this customer's specific package when using
2661 experimental package balances on all invoices with date earlier than
2662 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2663 see L<Time::Local> and L<Date::Parse> for conversion functions.
2664
2665 =cut
2666
2667 sub total_owed_date_pkgnum {
2668   my( $self, $time, $pkgnum ) = @_;
2669
2670   my $total_bill = 0;
2671   foreach my $cust_bill (
2672     grep { $_->_date <= $time }
2673       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2674   ) {
2675     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2676   }
2677   sprintf( "%.2f", $total_bill );
2678
2679 }
2680
2681 =item total_paid
2682
2683 Returns the total amount of all payments.
2684
2685 =cut
2686
2687 sub total_paid {
2688   my $self = shift;
2689   my $total = 0;
2690   $total += $_->paid foreach $self->cust_pay;
2691   sprintf( "%.2f", $total );
2692 }
2693
2694 =item total_unapplied_credits
2695
2696 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2697 customer.  See L<FS::cust_credit/credited>.
2698
2699 =item total_credited
2700
2701 Old name for total_unapplied_credits.  Don't use.
2702
2703 =cut
2704
2705 sub total_credited {
2706   #carp "total_credited deprecated, use total_unapplied_credits";
2707   shift->total_unapplied_credits(@_);
2708 }
2709
2710 sub total_unapplied_credits {
2711   my $self = shift;
2712
2713   my $custnum = $self->custnum;
2714
2715   my $unapplied_sql = FS::cust_credit->unapplied_sql;
2716
2717   my $sql = "
2718     SELECT SUM($unapplied_sql) FROM cust_credit
2719       WHERE custnum = $custnum
2720   ";
2721
2722   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2723
2724 }
2725
2726 =item total_unapplied_credits_pkgnum PKGNUM
2727
2728 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2729 customer.  See L<FS::cust_credit/credited>.
2730
2731 =cut
2732
2733 sub total_unapplied_credits_pkgnum {
2734   my( $self, $pkgnum ) = @_;
2735   my $total_credit = 0;
2736   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2737   sprintf( "%.2f", $total_credit );
2738 }
2739
2740
2741 =item total_unapplied_payments
2742
2743 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2744 See L<FS::cust_pay/unapplied>.
2745
2746 =cut
2747
2748 sub total_unapplied_payments {
2749   my $self = shift;
2750
2751   my $custnum = $self->custnum;
2752
2753   my $unapplied_sql = FS::cust_pay->unapplied_sql;
2754
2755   my $sql = "
2756     SELECT SUM($unapplied_sql) FROM cust_pay
2757       WHERE custnum = $custnum
2758   ";
2759
2760   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2761
2762 }
2763
2764 =item total_unapplied_payments_pkgnum PKGNUM
2765
2766 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2767 specific package when using experimental package balances.  See
2768 L<FS::cust_pay/unapplied>.
2769
2770 =cut
2771
2772 sub total_unapplied_payments_pkgnum {
2773   my( $self, $pkgnum ) = @_;
2774   my $total_unapplied = 0;
2775   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2776   sprintf( "%.2f", $total_unapplied );
2777 }
2778
2779
2780 =item total_unapplied_refunds
2781
2782 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2783 customer.  See L<FS::cust_refund/unapplied>.
2784
2785 =cut
2786
2787 sub total_unapplied_refunds {
2788   my $self = shift;
2789   my $custnum = $self->custnum;
2790
2791   my $unapplied_sql = FS::cust_refund->unapplied_sql;
2792
2793   my $sql = "
2794     SELECT SUM($unapplied_sql) FROM cust_refund
2795       WHERE custnum = $custnum
2796   ";
2797
2798   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2799
2800 }
2801
2802 =item balance
2803
2804 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2805 total_unapplied_credits minus total_unapplied_payments).
2806
2807 =cut
2808
2809 sub balance {
2810   my $self = shift;
2811   $self->balance_date_range;
2812 }
2813
2814 =item balance_date TIME
2815
2816 Returns the balance for this customer, only considering invoices with date
2817 earlier than TIME (total_owed_date minus total_credited minus
2818 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2819 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2820 functions.
2821
2822 =cut
2823
2824 sub balance_date {
2825   my $self = shift;
2826   $self->balance_date_range(shift);
2827 }
2828
2829 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2830
2831 Returns the balance for this customer, optionally considering invoices with
2832 date earlier than START_TIME, and not later than END_TIME
2833 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2834
2835 Times are specified as SQL fragments or numeric
2836 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
2837 L<Date::Parse> for conversion functions.  The empty string can be passed
2838 to disable that time constraint completely.
2839
2840 Available options are:
2841
2842 =over 4
2843
2844 =item unapplied_date
2845
2846 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)
2847
2848 =back
2849
2850 =cut
2851
2852 sub balance_date_range {
2853   my $self = shift;
2854   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2855             ') FROM cust_main WHERE custnum='. $self->custnum;
2856   sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2857 }
2858
2859 =item balance_pkgnum PKGNUM
2860
2861 Returns the balance for this customer's specific package when using
2862 experimental package balances (total_owed plus total_unrefunded, minus
2863 total_unapplied_credits minus total_unapplied_payments)
2864
2865 =cut
2866
2867 sub balance_pkgnum {
2868   my( $self, $pkgnum ) = @_;
2869
2870   sprintf( "%.2f",
2871       $self->total_owed_pkgnum($pkgnum)
2872 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2873 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
2874     - $self->total_unapplied_credits_pkgnum($pkgnum)
2875     - $self->total_unapplied_payments_pkgnum($pkgnum)
2876   );
2877 }
2878
2879 =item in_transit_payments
2880
2881 Returns the total of requests for payments for this customer pending in
2882 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
2883
2884 =cut
2885
2886 sub in_transit_payments {
2887   my $self = shift;
2888   my $in_transit_payments = 0;
2889   foreach my $pay_batch ( qsearch('pay_batch', {
2890     'status' => 'I',
2891   } ) ) {
2892     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2893       'batchnum' => $pay_batch->batchnum,
2894       'custnum' => $self->custnum,
2895     } ) ) {
2896       $in_transit_payments += $cust_pay_batch->amount;
2897     }
2898   }
2899   sprintf( "%.2f", $in_transit_payments );
2900 }
2901
2902 =item payment_info
2903
2904 Returns a hash of useful information for making a payment.
2905
2906 =over 4
2907
2908 =item balance
2909
2910 Current balance.
2911
2912 =item payby
2913
2914 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2915 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2916 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2917
2918 =back
2919
2920 For credit card transactions:
2921
2922 =over 4
2923
2924 =item card_type 1
2925
2926 =item payname
2927
2928 Exact name on card
2929
2930 =back
2931
2932 For electronic check transactions:
2933
2934 =over 4
2935
2936 =item stateid_state
2937
2938 =back
2939
2940 =cut
2941
2942 sub payment_info {
2943   my $self = shift;
2944
2945   my %return = ();
2946
2947   $return{balance} = $self->balance;
2948
2949   $return{payname} = $self->payname
2950                      || ( $self->first. ' '. $self->get('last') );
2951
2952   $return{$_} = $self->bill_location->$_
2953     for qw(address1 address2 city state zip);
2954
2955   $return{payby} = $self->payby;
2956   $return{stateid_state} = $self->stateid_state;
2957
2958   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2959     $return{card_type} = cardtype($self->payinfo);
2960     $return{payinfo} = $self->paymask;
2961
2962     @return{'month', 'year'} = $self->paydate_monthyear;
2963
2964   }
2965
2966   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2967     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2968     $return{payinfo1} = $payinfo1;
2969     $return{payinfo2} = $payinfo2;
2970     $return{paytype}  = $self->paytype;
2971     $return{paystate} = $self->paystate;
2972
2973   }
2974
2975   #doubleclick protection
2976   my $_date = time;
2977   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2978
2979   %return;
2980
2981 }
2982
2983 =item paydate_monthyear
2984
2985 Returns a two-element list consisting of the month and year of this customer's
2986 paydate (credit card expiration date for CARD customers)
2987
2988 =cut
2989
2990 sub paydate_monthyear {
2991   my $self = shift;
2992   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
2993     ( $2, $1 );
2994   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
2995     ( $1, $3 );
2996   } else {
2997     ('', '');
2998   }
2999 }
3000
3001 =item paydate_epoch
3002
3003 Returns the exact time in seconds corresponding to the payment method
3004 expiration date.  For CARD/DCRD customers this is the end of the month;
3005 for others (COMP is the only other payby that uses paydate) it's the start.
3006 Returns 0 if the paydate is empty or set to the far future.
3007
3008 =cut
3009
3010 sub paydate_epoch {
3011   my $self = shift;
3012   my ($month, $year) = $self->paydate_monthyear;
3013   return 0 if !$year or $year >= 2037;
3014   if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
3015     $month++;
3016     if ( $month == 13 ) {
3017       $month = 1;
3018       $year++;
3019     }
3020     return timelocal(0,0,0,1,$month-1,$year) - 1;
3021   }
3022   else {
3023     return timelocal(0,0,0,1,$month-1,$year);
3024   }
3025 }
3026
3027 =item paydate_epoch_sql
3028
3029 Class method.  Returns an SQL expression to obtain the payment expiration date
3030 as a number of seconds.
3031
3032 =cut
3033
3034 # Special expiration date behavior for non-CARD/DCRD customers has been
3035 # carefully preserved.  Do we really use that?
3036 sub paydate_epoch_sql {
3037   my $class = shift;
3038   my $table = shift || 'cust_main';
3039   my ($case1, $case2);
3040   if ( driver_name eq 'Pg' ) {
3041     $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
3042     $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
3043   }
3044   elsif ( lc(driver_name) eq 'mysql' ) {
3045     $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
3046     $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
3047   }
3048   else { return '' }
3049   return "CASE WHEN $table.payby IN('CARD','DCRD')
3050   THEN ($case1)
3051   ELSE ($case2)
3052   END"
3053 }
3054
3055 =item tax_exemption TAXNAME
3056
3057 =cut
3058
3059 sub tax_exemption {
3060   my( $self, $taxname ) = @_;
3061
3062   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3063                                      'taxname' => $taxname,
3064                                    },
3065           );
3066 }
3067
3068 =item cust_main_exemption
3069
3070 =cut
3071
3072 sub cust_main_exemption {
3073   my $self = shift;
3074   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3075 }
3076
3077 =item invoicing_list [ ARRAYREF ]
3078
3079 If an arguement is given, sets these email addresses as invoice recipients
3080 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3081 (except as warnings), so use check_invoicing_list first.
3082
3083 Returns a list of email addresses (with svcnum entries expanded).
3084
3085 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3086 check it without disturbing anything by passing nothing.
3087
3088 This interface may change in the future.
3089
3090 =cut
3091
3092 sub invoicing_list {
3093   my( $self, $arrayref ) = @_;
3094
3095   if ( $arrayref ) {
3096     my @cust_main_invoice;
3097     if ( $self->custnum ) {
3098       @cust_main_invoice =
3099         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3100     } else {
3101       @cust_main_invoice = ();
3102     }
3103     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3104       #warn $cust_main_invoice->destnum;
3105       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3106         #warn $cust_main_invoice->destnum;
3107         my $error = $cust_main_invoice->delete;
3108         warn $error if $error;
3109       }
3110     }
3111     if ( $self->custnum ) {
3112       @cust_main_invoice =
3113         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3114     } else {
3115       @cust_main_invoice = ();
3116     }
3117     my %seen = map { $_->address => 1 } @cust_main_invoice;
3118     foreach my $address ( @{$arrayref} ) {
3119       next if exists $seen{$address} && $seen{$address};
3120       $seen{$address} = 1;
3121       my $cust_main_invoice = new FS::cust_main_invoice ( {
3122         'custnum' => $self->custnum,
3123         'dest'    => $address,
3124       } );
3125       my $error = $cust_main_invoice->insert;
3126       warn $error if $error;
3127     }
3128   }
3129
3130   if ( $self->custnum ) {
3131     map { $_->address }
3132       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3133   } else {
3134     ();
3135   }
3136
3137 }
3138
3139 =item check_invoicing_list ARRAYREF
3140
3141 Checks these arguements as valid input for the invoicing_list method.  If there
3142 is an error, returns the error, otherwise returns false.
3143
3144 =cut
3145
3146 sub check_invoicing_list {
3147   my( $self, $arrayref ) = @_;
3148
3149   foreach my $address ( @$arrayref ) {
3150
3151     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3152       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3153     }
3154
3155     my $cust_main_invoice = new FS::cust_main_invoice ( {
3156       'custnum' => $self->custnum,
3157       'dest'    => $address,
3158     } );
3159     my $error = $self->custnum
3160                 ? $cust_main_invoice->check
3161                 : $cust_main_invoice->checkdest
3162     ;
3163     return $error if $error;
3164
3165   }
3166
3167   return "Email address required"
3168     if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3169     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3170
3171   '';
3172 }
3173
3174 =item set_default_invoicing_list
3175
3176 Sets the invoicing list to all accounts associated with this customer,
3177 overwriting any previous invoicing list.
3178
3179 =cut
3180
3181 sub set_default_invoicing_list {
3182   my $self = shift;
3183   $self->invoicing_list($self->all_emails);
3184 }
3185
3186 =item all_emails
3187
3188 Returns the email addresses of all accounts provisioned for this customer.
3189
3190 =cut
3191
3192 sub all_emails {
3193   my $self = shift;
3194   my %list;
3195   foreach my $cust_pkg ( $self->all_pkgs ) {
3196     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3197     my @svc_acct =
3198       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3199         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3200           @cust_svc;
3201     $list{$_}=1 foreach map { $_->email } @svc_acct;
3202   }
3203   keys %list;
3204 }
3205
3206 =item invoicing_list_addpost
3207
3208 Adds postal invoicing to this customer.  If this customer is already configured
3209 to receive postal invoices, does nothing.
3210
3211 =cut
3212
3213 sub invoicing_list_addpost {
3214   my $self = shift;
3215   return if grep { $_ eq 'POST' } $self->invoicing_list;
3216   my @invoicing_list = $self->invoicing_list;
3217   push @invoicing_list, 'POST';
3218   $self->invoicing_list(\@invoicing_list);
3219 }
3220
3221 =item invoicing_list_emailonly
3222
3223 Returns the list of email invoice recipients (invoicing_list without non-email
3224 destinations such as POST and FAX).
3225
3226 =cut
3227
3228 sub invoicing_list_emailonly {
3229   my $self = shift;
3230   warn "$me invoicing_list_emailonly called"
3231     if $DEBUG;
3232   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3233 }
3234
3235 =item invoicing_list_emailonly_scalar
3236
3237 Returns the list of email invoice recipients (invoicing_list without non-email
3238 destinations such as POST and FAX) as a comma-separated scalar.
3239
3240 =cut
3241
3242 sub invoicing_list_emailonly_scalar {
3243   my $self = shift;
3244   warn "$me invoicing_list_emailonly_scalar called"
3245     if $DEBUG;
3246   join(', ', $self->invoicing_list_emailonly);
3247 }
3248
3249 =item referral_custnum_cust_main
3250
3251 Returns the customer who referred this customer (or the empty string, if
3252 this customer was not referred).
3253
3254 Note the difference with referral_cust_main method: This method,
3255 referral_custnum_cust_main returns the single customer (if any) who referred
3256 this customer, while referral_cust_main returns an array of customers referred
3257 BY this customer.
3258
3259 =cut
3260
3261 sub referral_custnum_cust_main {
3262   my $self = shift;
3263   return '' unless $self->referral_custnum;
3264   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3265 }
3266
3267 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3268
3269 Returns an array of customers referred by this customer (referral_custnum set
3270 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3271 customers referred by customers referred by this customer and so on, inclusive.
3272 The default behavior is DEPTH 1 (no recursion).
3273
3274 Note the difference with referral_custnum_cust_main method: This method,
3275 referral_cust_main, returns an array of customers referred BY this customer,
3276 while referral_custnum_cust_main returns the single customer (if any) who
3277 referred this customer.
3278
3279 =cut
3280
3281 sub referral_cust_main {
3282   my $self = shift;
3283   my $depth = @_ ? shift : 1;
3284   my $exclude = @_ ? shift : {};
3285
3286   my @cust_main =
3287     map { $exclude->{$_->custnum}++; $_; }
3288       grep { ! $exclude->{ $_->custnum } }
3289         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3290
3291   if ( $depth > 1 ) {
3292     push @cust_main,
3293       map { $_->referral_cust_main($depth-1, $exclude) }
3294         @cust_main;
3295   }
3296
3297   @cust_main;
3298 }
3299
3300 =item referral_cust_main_ncancelled
3301
3302 Same as referral_cust_main, except only returns customers with uncancelled
3303 packages.
3304
3305 =cut
3306
3307 sub referral_cust_main_ncancelled {
3308   my $self = shift;
3309   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3310 }
3311
3312 =item referral_cust_pkg [ DEPTH ]
3313
3314 Like referral_cust_main, except returns a flat list of all unsuspended (and
3315 uncancelled) packages for each customer.  The number of items in this list may
3316 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3317
3318 =cut
3319
3320 sub referral_cust_pkg {
3321   my $self = shift;
3322   my $depth = @_ ? shift : 1;
3323
3324   map { $_->unsuspended_pkgs }
3325     grep { $_->unsuspended_pkgs }
3326       $self->referral_cust_main($depth);
3327 }
3328
3329 =item referring_cust_main
3330
3331 Returns the single cust_main record for the customer who referred this customer
3332 (referral_custnum), or false.
3333
3334 =cut
3335
3336 sub referring_cust_main {
3337   my $self = shift;
3338   return '' unless $self->referral_custnum;
3339   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3340 }
3341
3342 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3343
3344 Applies a credit to this customer.  If there is an error, returns the error,
3345 otherwise returns false.
3346
3347 REASON can be a text string, an FS::reason object, or a scalar reference to
3348 a reasonnum.  If a text string, it will be automatically inserted as a new
3349 reason, and a 'reason_type' option must be passed to indicate the
3350 FS::reason_type for the new reason.
3351
3352 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3353 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3354 I<commission_pkgnum>.
3355
3356 Any other options are passed to FS::cust_credit::insert.
3357
3358 =cut
3359
3360 sub credit {
3361   my( $self, $amount, $reason, %options ) = @_;
3362
3363   my $cust_credit = new FS::cust_credit {
3364     'custnum' => $self->custnum,
3365     'amount'  => $amount,
3366   };
3367
3368   if ( ref($reason) ) {
3369
3370     if ( ref($reason) eq 'SCALAR' ) {
3371       $cust_credit->reasonnum( $$reason );
3372     } else {
3373       $cust_credit->reasonnum( $reason->reasonnum );
3374     }
3375
3376   } else {
3377     $cust_credit->set('reason', $reason)
3378   }
3379
3380   $cust_credit->$_( delete $options{$_} )
3381     foreach grep exists($options{$_}),
3382               qw( addlinfo eventnum ),
3383               map "commission_$_", qw( agentnum salesnum pkgnum );
3384
3385   $cust_credit->insert(%options);
3386
3387 }
3388
3389 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3390
3391 Creates a one-time charge for this customer.  If there is an error, returns
3392 the error, otherwise returns false.
3393
3394 New-style, with a hashref of options:
3395
3396   my $error = $cust_main->charge(
3397                                   {
3398                                     'amount'     => 54.32,
3399                                     'quantity'   => 1,
3400                                     'start_date' => str2time('7/4/2009'),
3401                                     'pkg'        => 'Description',
3402                                     'comment'    => 'Comment',
3403                                     'additional' => [], #extra invoice detail
3404                                     'classnum'   => 1,  #pkg_class
3405
3406                                     'setuptax'   => '', # or 'Y' for tax exempt
3407
3408                                     'locationnum'=> 1234, # optional
3409
3410                                     #internal taxation
3411                                     'taxclass'   => 'Tax class',
3412
3413                                     #vendor taxation
3414                                     'taxproduct' => 2,  #part_pkg_taxproduct
3415                                     'override'   => {}, #XXX describe
3416
3417                                     #will be filled in with the new object
3418                                     'cust_pkg_ref' => \$cust_pkg,
3419
3420                                     #generate an invoice immediately
3421                                     'bill_now' => 0,
3422                                     'invoice_terms' => '', #with these terms
3423                                   }
3424                                 );
3425
3426 Old-style:
3427
3428   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3429
3430 =cut
3431
3432 sub charge {
3433   my $self = shift;
3434   my ( $amount, $quantity, $start_date, $classnum );
3435   my ( $pkg, $comment, $additional );
3436   my ( $setuptax, $taxclass );   #internal taxes
3437   my ( $taxproduct, $override ); #vendor (CCH) taxes
3438   my $no_auto = '';
3439   my $cust_pkg_ref = '';
3440   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3441   my $locationnum;
3442   if ( ref( $_[0] ) ) {
3443     $amount     = $_[0]->{amount};
3444     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3445     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3446     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3447     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3448     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3449                                            : '$'. sprintf("%.2f",$amount);
3450     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3451     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3452     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3453     $additional = $_[0]->{additional} || [];
3454     $taxproduct = $_[0]->{taxproductnum};
3455     $override   = { '' => $_[0]->{tax_override} };
3456     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3457     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3458     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3459     $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3460   } else {
3461     $amount     = shift;
3462     $quantity   = 1;
3463     $start_date = '';
3464     $pkg        = @_ ? shift : 'One-time charge';
3465     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3466     $setuptax   = '';
3467     $taxclass   = @_ ? shift : '';
3468     $additional = [];
3469   }
3470
3471   local $SIG{HUP} = 'IGNORE';
3472   local $SIG{INT} = 'IGNORE';
3473   local $SIG{QUIT} = 'IGNORE';
3474   local $SIG{TERM} = 'IGNORE';
3475   local $SIG{TSTP} = 'IGNORE';
3476   local $SIG{PIPE} = 'IGNORE';
3477
3478   my $oldAutoCommit = $FS::UID::AutoCommit;
3479   local $FS::UID::AutoCommit = 0;
3480   my $dbh = dbh;
3481
3482   my $part_pkg = new FS::part_pkg ( {
3483     'pkg'           => $pkg,
3484     'comment'       => $comment,
3485     'plan'          => 'flat',
3486     'freq'          => 0,
3487     'disabled'      => 'Y',
3488     'classnum'      => ( $classnum ? $classnum : '' ),
3489     'setuptax'      => $setuptax,
3490     'taxclass'      => $taxclass,
3491     'taxproductnum' => $taxproduct,
3492   } );
3493
3494   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3495                         ( 0 .. @$additional - 1 )
3496                   ),
3497                   'additional_count' => scalar(@$additional),
3498                   'setup_fee' => $amount,
3499                 );
3500
3501   my $error = $part_pkg->insert( options       => \%options,
3502                                  tax_overrides => $override,
3503                                );
3504   if ( $error ) {
3505     $dbh->rollback if $oldAutoCommit;
3506     return $error;
3507   }
3508
3509   my $pkgpart = $part_pkg->pkgpart;
3510   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3511   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3512     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3513     $error = $type_pkgs->insert;
3514     if ( $error ) {
3515       $dbh->rollback if $oldAutoCommit;
3516       return $error;
3517     }
3518   }
3519
3520   my $cust_pkg = new FS::cust_pkg ( {
3521     'custnum'    => $self->custnum,
3522     'pkgpart'    => $pkgpart,
3523     'quantity'   => $quantity,
3524     'start_date' => $start_date,
3525     'no_auto'    => $no_auto,
3526     'locationnum'=> $locationnum,
3527   } );
3528
3529   $error = $cust_pkg->insert;
3530   if ( $error ) {
3531     $dbh->rollback if $oldAutoCommit;
3532     return $error;
3533   } elsif ( $cust_pkg_ref ) {
3534     ${$cust_pkg_ref} = $cust_pkg;
3535   }
3536
3537   if ( $bill_now ) {
3538     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3539                              'pkg_list'      => [ $cust_pkg ],
3540                            );
3541     if ( $error ) {
3542       $dbh->rollback if $oldAutoCommit;
3543       return $error;
3544     }
3545   }
3546
3547   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3548   return '';
3549
3550 }
3551
3552 #=item charge_postal_fee
3553 #
3554 #Applies a one time charge this customer.  If there is an error,
3555 #returns the error, returns the cust_pkg charge object or false
3556 #if there was no charge.
3557 #
3558 #=cut
3559 #
3560 # This should be a customer event.  For that to work requires that bill
3561 # also be a customer event.
3562
3563 sub charge_postal_fee {
3564   my $self = shift;
3565
3566   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3567   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3568
3569   my $cust_pkg = new FS::cust_pkg ( {
3570     'custnum'  => $self->custnum,
3571     'pkgpart'  => $pkgpart,
3572     'quantity' => 1,
3573   } );
3574
3575   my $error = $cust_pkg->insert;
3576   $error ? $error : $cust_pkg;
3577 }
3578
3579 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3580
3581 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3582
3583 Optionally, a list or hashref of additional arguments to the qsearch call can
3584 be passed.
3585
3586 =cut
3587
3588 sub cust_bill {
3589   my $self = shift;
3590   my $opt = ref($_[0]) ? shift : { @_ };
3591
3592   #return $self->num_cust_bill unless wantarray || keys %$opt;
3593
3594   $opt->{'table'} = 'cust_bill';
3595   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3596   $opt->{'hashref'}{'custnum'} = $self->custnum;
3597   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3598
3599   map { $_ } #behavior of sort undefined in scalar context
3600     sort { $a->_date <=> $b->_date }
3601       qsearch($opt);
3602 }
3603
3604 =item open_cust_bill
3605
3606 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3607 customer.
3608
3609 =cut
3610
3611 sub open_cust_bill {
3612   my $self = shift;
3613
3614   $self->cust_bill(
3615     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3616     #@_
3617   );
3618
3619 }
3620
3621 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3622
3623 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3624
3625 =cut
3626
3627 sub legacy_cust_bill {
3628   my $self = shift;
3629
3630   #return $self->num_legacy_cust_bill unless wantarray;
3631
3632   map { $_ } #behavior of sort undefined in scalar context
3633     sort { $a->_date <=> $b->_date }
3634       qsearch({ 'table'    => 'legacy_cust_bill',
3635                 'hashref'  => { 'custnum' => $self->custnum, },
3636                 'order_by' => 'ORDER BY _date ASC',
3637              });
3638 }
3639
3640 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3641
3642 Returns all the statements (see L<FS::cust_statement>) for this customer.
3643
3644 Optionally, a list or hashref of additional arguments to the qsearch call can
3645 be passed.
3646
3647 =cut
3648
3649 =item cust_bill_void
3650
3651 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3652
3653 =cut
3654
3655 sub cust_bill_void {
3656   my $self = shift;
3657
3658   map { $_ } #return $self->num_cust_bill_void unless wantarray;
3659   sort { $a->_date <=> $b->_date }
3660     qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3661 }
3662
3663 sub cust_statement {
3664   my $self = shift;
3665   my $opt = ref($_[0]) ? shift : { @_ };
3666
3667   #return $self->num_cust_statement unless wantarray || keys %$opt;
3668
3669   $opt->{'table'} = 'cust_statement';
3670   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3671   $opt->{'hashref'}{'custnum'} = $self->custnum;
3672   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3673
3674   map { $_ } #behavior of sort undefined in scalar context
3675     sort { $a->_date <=> $b->_date }
3676       qsearch($opt);
3677 }
3678
3679 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3680
3681 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3682
3683 Optionally, a list or hashref of additional arguments to the qsearch call can
3684 be passed following the SVCDB.
3685
3686 =cut
3687
3688 sub svc_x {
3689   my $self = shift;
3690   my $svcdb = shift;
3691   if ( ! $svcdb =~ /^svc_\w+$/ ) {
3692     warn "$me svc_x requires a svcdb";
3693     return;
3694   }
3695   my $opt = ref($_[0]) ? shift : { @_ };
3696
3697   $opt->{'table'} = $svcdb;
3698   $opt->{'addl_from'} =
3699     'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3700     ($opt->{'addl_from'} || '');
3701
3702   my $custnum = $self->custnum;
3703   $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3704   my $where = "cust_pkg.custnum = $custnum";
3705
3706   my $extra_sql = $opt->{'extra_sql'} || '';
3707   if ( keys %{ $opt->{'hashref'} } ) {
3708     $extra_sql = " AND $where $extra_sql";
3709   }
3710   else {
3711     if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3712       $extra_sql = "WHERE $where AND $1";
3713     }
3714     else {
3715       $extra_sql = "WHERE $where $extra_sql";
3716     }
3717   }
3718   $opt->{'extra_sql'} = $extra_sql;
3719
3720   qsearch($opt);
3721 }
3722
3723 # required for use as an eventtable;
3724 sub svc_acct {
3725   my $self = shift;
3726   $self->svc_x('svc_acct', @_);
3727 }
3728
3729 =item cust_credit
3730
3731 Returns all the credits (see L<FS::cust_credit>) for this customer.
3732
3733 =cut
3734
3735 sub cust_credit {
3736   my $self = shift;
3737   map { $_ } #return $self->num_cust_credit unless wantarray;
3738   sort { $a->_date <=> $b->_date }
3739     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3740 }
3741
3742 =item cust_credit_pkgnum
3743
3744 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3745 package when using experimental package balances.
3746
3747 =cut
3748
3749 sub cust_credit_pkgnum {
3750   my( $self, $pkgnum ) = @_;
3751   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3752   sort { $a->_date <=> $b->_date }
3753     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3754                               'pkgnum'  => $pkgnum,
3755                             }
3756     );
3757 }
3758
3759 =item cust_credit_void
3760
3761 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3762
3763 =cut
3764
3765 sub cust_credit_void {
3766   my $self = shift;
3767   map { $_ }
3768   sort { $a->_date <=> $b->_date }
3769     qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3770 }
3771
3772 =item cust_pay
3773
3774 Returns all the payments (see L<FS::cust_pay>) for this customer.
3775
3776 =cut
3777
3778 sub cust_pay {
3779   my $self = shift;
3780   return $self->num_cust_pay unless wantarray;
3781   sort { $a->_date <=> $b->_date }
3782     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3783 }
3784
3785 =item num_cust_pay
3786
3787 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3788 called automatically when the cust_pay method is used in a scalar context.
3789
3790 =cut
3791
3792 sub num_cust_pay {
3793   my $self = shift;
3794   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3795   my $sth = dbh->prepare($sql) or die dbh->errstr;
3796   $sth->execute($self->custnum) or die $sth->errstr;
3797   $sth->fetchrow_arrayref->[0];
3798 }
3799
3800 =item cust_pay_pkgnum
3801
3802 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3803 package when using experimental package balances.
3804
3805 =cut
3806
3807 sub cust_pay_pkgnum {
3808   my( $self, $pkgnum ) = @_;
3809   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3810   sort { $a->_date <=> $b->_date }
3811     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3812                            'pkgnum'  => $pkgnum,
3813                          }
3814     );
3815 }
3816
3817 =item cust_pay_void
3818
3819 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3820
3821 =cut
3822
3823 sub cust_pay_void {
3824   my $self = shift;
3825   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3826   sort { $a->_date <=> $b->_date }
3827     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3828 }
3829
3830 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3831
3832 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
3833
3834 Optionally, a list or hashref of additional arguments to the qsearch call can
3835 be passed.
3836
3837 =cut
3838
3839 sub cust_pay_batch {
3840   my $self = shift;
3841   my $opt = ref($_[0]) ? shift : { @_ };
3842
3843   #return $self->num_cust_statement unless wantarray || keys %$opt;
3844
3845   $opt->{'table'} = 'cust_pay_batch';
3846   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3847   $opt->{'hashref'}{'custnum'} = $self->custnum;
3848   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3849
3850   map { $_ } #behavior of sort undefined in scalar context
3851     sort { $a->paybatchnum <=> $b->paybatchnum }
3852       qsearch($opt);
3853 }
3854
3855 =item cust_pay_pending
3856
3857 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3858 (without status "done").
3859
3860 =cut
3861
3862 sub cust_pay_pending {
3863   my $self = shift;
3864   return $self->num_cust_pay_pending unless wantarray;
3865   sort { $a->_date <=> $b->_date }
3866     qsearch( 'cust_pay_pending', {
3867                                    'custnum' => $self->custnum,
3868                                    'status'  => { op=>'!=', value=>'done' },
3869                                  },
3870            );
3871 }
3872
3873 =item cust_pay_pending_attempt
3874
3875 Returns all payment attempts / declined payments for this customer, as pending
3876 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3877 a corresponding payment (see L<FS::cust_pay>).
3878
3879 =cut
3880
3881 sub cust_pay_pending_attempt {
3882   my $self = shift;
3883   return $self->num_cust_pay_pending_attempt unless wantarray;
3884   sort { $a->_date <=> $b->_date }
3885     qsearch( 'cust_pay_pending', {
3886                                    'custnum' => $self->custnum,
3887                                    'status'  => 'done',
3888                                    'paynum'  => '',
3889                                  },
3890            );
3891 }
3892
3893 =item num_cust_pay_pending
3894
3895 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3896 customer (without status "done").  Also called automatically when the
3897 cust_pay_pending method is used in a scalar context.
3898
3899 =cut
3900
3901 sub num_cust_pay_pending {
3902   my $self = shift;
3903   $self->scalar_sql(
3904     " SELECT COUNT(*) FROM cust_pay_pending ".
3905       " WHERE custnum = ? AND status != 'done' ",
3906     $self->custnum
3907   );
3908 }
3909
3910 =item num_cust_pay_pending_attempt
3911
3912 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3913 customer, with status "done" but without a corresp.  Also called automatically when the
3914 cust_pay_pending method is used in a scalar context.
3915
3916 =cut
3917
3918 sub num_cust_pay_pending_attempt {
3919   my $self = shift;
3920   $self->scalar_sql(
3921     " SELECT COUNT(*) FROM cust_pay_pending ".
3922       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3923     $self->custnum
3924   );
3925 }
3926
3927 =item cust_refund
3928
3929 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3930
3931 =cut
3932
3933 sub cust_refund {
3934   my $self = shift;
3935   map { $_ } #return $self->num_cust_refund unless wantarray;
3936   sort { $a->_date <=> $b->_date }
3937     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3938 }
3939
3940 =item display_custnum
3941
3942 Returns the displayed customer number for this customer: agent_custid if
3943 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3944
3945 =cut
3946
3947 sub display_custnum {
3948   my $self = shift;
3949
3950   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3951   if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3952     if ( $special eq 'CoStAg' ) {
3953       $prefix = uc( join('',
3954         $self->country,
3955         ($self->state =~ /^(..)/),
3956         $prefix || ($self->agent->agent =~ /^(..)/)
3957       ) );
3958     }
3959     elsif ( $special eq 'CoStCl' ) {
3960       $prefix = uc( join('',
3961         $self->country,
3962         ($self->state =~ /^(..)/),
3963         ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
3964       ) );
3965     }
3966     # add any others here if needed
3967   }
3968
3969   my $length = $conf->config('cust_main-custnum-display_length');
3970   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3971     return $self->agent_custid;
3972   } elsif ( $prefix ) {
3973     $length = 8 if !defined($length);
3974     return $prefix .
3975            sprintf('%0'.$length.'d', $self->custnum)
3976   } elsif ( $length ) {
3977     return sprintf('%0'.$length.'d', $self->custnum);
3978   } else {
3979     return $self->custnum;
3980   }
3981 }
3982
3983 =item name
3984
3985 Returns a name string for this customer, either "Company (Last, First)" or
3986 "Last, First".
3987
3988 =cut
3989
3990 sub name {
3991   my $self = shift;
3992   my $name = $self->contact;
3993   $name = $self->company. " ($name)" if $self->company;
3994   $name;
3995 }
3996
3997 =item service_contact
3998
3999 Returns the L<FS::contact> object for this customer that has the 'Service'
4000 contact class, or undef if there is no such contact.  Deprecated; don't use
4001 this in new code.
4002
4003 =cut
4004
4005 sub service_contact {
4006   my $self = shift;
4007   if ( !exists($self->{service_contact}) ) {
4008     my $classnum = $self->scalar_sql(
4009       'SELECT classnum FROM contact_class WHERE classname = \'Service\''
4010     ) || 0; #if it's zero, qsearchs will return nothing
4011     $self->{service_contact} = qsearchs('contact', {
4012         'classnum' => $classnum, 'custnum' => $self->custnum
4013       }) || undef;
4014   }
4015   $self->{service_contact};
4016 }
4017
4018 =item ship_name
4019
4020 Returns a name string for this (service/shipping) contact, either
4021 "Company (Last, First)" or "Last, First".
4022
4023 =cut
4024
4025 sub ship_name {
4026   my $self = shift;
4027
4028   my $name = $self->ship_contact;
4029   $name = $self->company. " ($name)" if $self->company;
4030   $name;
4031 }
4032
4033 =item name_short
4034
4035 Returns a name string for this customer, either "Company" or "First Last".
4036
4037 =cut
4038
4039 sub name_short {
4040   my $self = shift;
4041   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4042 }
4043
4044 =item ship_name_short
4045
4046 Returns a name string for this (service/shipping) contact, either "Company"
4047 or "First Last".
4048
4049 =cut
4050
4051 sub ship_name_short {
4052   my $self = shift;
4053   $self->service_contact
4054     ? $self->ship_contact_firstlast
4055     : $self->name_short
4056 }
4057
4058 =item contact
4059
4060 Returns this customer's full (billing) contact name only, "Last, First"
4061
4062 =cut
4063
4064 sub contact {
4065   my $self = shift;
4066   $self->get('last'). ', '. $self->first;
4067 }
4068
4069 =item ship_contact
4070
4071 Returns this customer's full (shipping) contact name only, "Last, First"
4072
4073 =cut
4074
4075 sub ship_contact {
4076   my $self = shift;
4077   my $contact = $self->service_contact || $self;
4078   $contact->get('last') . ', ' . $contact->get('first');
4079 }
4080
4081 =item contact_firstlast
4082
4083 Returns this customers full (billing) contact name only, "First Last".
4084
4085 =cut
4086
4087 sub contact_firstlast {
4088   my $self = shift;
4089   $self->first. ' '. $self->get('last');
4090 }
4091
4092 =item ship_contact_firstlast
4093
4094 Returns this customer's full (shipping) contact name only, "First Last".
4095
4096 =cut
4097
4098 sub ship_contact_firstlast {
4099   my $self = shift;
4100   my $contact = $self->service_contact || $self;
4101   $contact->get('first') . ' '. $contact->get('last');
4102 }
4103
4104 #XXX this doesn't work in 3.x+
4105 #=item country_full
4106 #
4107 #Returns this customer's full country name
4108 #
4109 #=cut
4110 #
4111 #sub country_full {
4112 #  my $self = shift;
4113 #  code2country($self->country);
4114 #}
4115
4116 sub bill_country_full {
4117   my $self = shift;
4118   code2country($self->bill_location->country);
4119 }
4120
4121 sub ship_country_full {
4122   my $self = shift;
4123   code2country($self->ship_location->country);
4124 }
4125
4126 =item county_state_county [ PREFIX ]
4127
4128 Returns a string consisting of just the county, state and country.
4129
4130 =cut
4131
4132 sub county_state_country {
4133   my $self = shift;
4134   my $locationnum;
4135   if ( @_ && $_[0] && $self->has_ship_address ) {
4136     $locationnum = $self->ship_locationnum;
4137   } else {
4138     $locationnum = $self->bill_locationnum;
4139   }
4140   my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4141   $cust_location->county_state_country;
4142 }
4143
4144 =item geocode DATA_VENDOR
4145
4146 Returns a value for the customer location as encoded by DATA_VENDOR.
4147 Currently this only makes sense for "CCH" as DATA_VENDOR.
4148
4149 =cut
4150
4151 =item cust_status
4152
4153 =item status
4154
4155 Returns a status string for this customer, currently:
4156
4157 =over 4
4158
4159 =item prospect - No packages have ever been ordered
4160
4161 =item ordered - Recurring packages all are new (not yet billed).
4162
4163 =item active - One or more recurring packages is active
4164
4165 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4166
4167 =item suspended - All non-cancelled recurring packages are suspended
4168
4169 =item cancelled - All recurring packages are cancelled
4170
4171 =back
4172
4173 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4174 cust_main-status_module configuration option.
4175
4176 =cut
4177
4178 sub status { shift->cust_status(@_); }
4179
4180 sub cust_status {
4181   my $self = shift;
4182   for my $status ( FS::cust_main->statuses() ) {
4183     my $method = $status.'_sql';
4184     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4185     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4186     $sth->execute( ($self->custnum) x $numnum )
4187       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4188     return $status if $sth->fetchrow_arrayref->[0];
4189   }
4190 }
4191
4192 =item ucfirst_cust_status
4193
4194 =item ucfirst_status
4195
4196 Returns the status with the first character capitalized.
4197
4198 =cut
4199
4200 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4201
4202 sub ucfirst_cust_status {
4203   my $self = shift;
4204   ucfirst($self->cust_status);
4205 }
4206
4207 =item statuscolor
4208
4209 Returns a hex triplet color string for this customer's status.
4210
4211 =cut
4212
4213 sub statuscolor { shift->cust_statuscolor(@_); }
4214
4215 sub cust_statuscolor {
4216   my $self = shift;
4217   __PACKAGE__->statuscolors->{$self->cust_status};
4218 }
4219
4220 =item tickets
4221
4222 Returns an array of hashes representing the customer's RT tickets.
4223
4224 =cut
4225
4226 sub tickets {
4227   my $self = shift;
4228
4229   my $num = $conf->config('cust_main-max_tickets') || 10;
4230   my @tickets = ();
4231
4232   if ( $conf->config('ticket_system') ) {
4233     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4234
4235       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
4236
4237     } else {
4238
4239       foreach my $priority (
4240         $conf->config('ticket_system-custom_priority_field-values'), ''
4241       ) {
4242         last if scalar(@tickets) >= $num;
4243         push @tickets,
4244           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4245                                                  $num - scalar(@tickets),
4246                                                  $priority,
4247                                                )
4248            };
4249       }
4250     }
4251   }
4252   (@tickets);
4253 }
4254
4255 # Return services representing svc_accts in customer support packages
4256 sub support_services {
4257   my $self = shift;
4258   my %packages = map { $_ => 1 } $conf->config('support_packages');
4259
4260   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4261     grep { $_->part_svc->svcdb eq 'svc_acct' }
4262     map { $_->cust_svc }
4263     grep { exists $packages{ $_->pkgpart } }
4264     $self->ncancelled_pkgs;
4265
4266 }
4267
4268 # Return a list of latitude/longitude for one of the services (if any)
4269 sub service_coordinates {
4270   my $self = shift;
4271
4272   my @svc_X =
4273     grep { $_->latitude && $_->longitude }
4274     map { $_->svc_x }
4275     map { $_->cust_svc }
4276     $self->ncancelled_pkgs;
4277
4278   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4279 }
4280
4281 =item masked FIELD
4282
4283 Returns a masked version of the named field
4284
4285 =cut
4286
4287 sub masked {
4288 my ($self,$field) = @_;
4289
4290 # Show last four
4291
4292 'x'x(length($self->getfield($field))-4).
4293   substr($self->getfield($field), (length($self->getfield($field))-4));
4294
4295 }
4296
4297 =back
4298
4299 =head1 CLASS METHODS
4300
4301 =over 4
4302
4303 =item statuses
4304
4305 Class method that returns the list of possible status strings for customers
4306 (see L<the status method|/status>).  For example:
4307
4308   @statuses = FS::cust_main->statuses();
4309
4310 =cut
4311
4312 sub statuses {
4313   my $self = shift;
4314   keys %{ $self->statuscolors };
4315 }
4316
4317 =item cust_status_sql
4318
4319 Returns an SQL fragment to determine the status of a cust_main record, as a
4320 string.
4321
4322 =cut
4323
4324 sub cust_status_sql {
4325   my $sql = 'CASE';
4326   for my $status ( FS::cust_main->statuses() ) {
4327     my $method = $status.'_sql';
4328     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4329   }
4330   $sql .= ' END';
4331   return $sql;
4332 }
4333
4334
4335 =item prospect_sql
4336
4337 Returns an SQL expression identifying prospective cust_main records (customers
4338 with no packages ever ordered)
4339
4340 =cut
4341
4342 use vars qw($select_count_pkgs);
4343 $select_count_pkgs =
4344   "SELECT COUNT(*) FROM cust_pkg
4345     WHERE cust_pkg.custnum = cust_main.custnum";
4346
4347 sub select_count_pkgs_sql {
4348   $select_count_pkgs;
4349 }
4350
4351 sub prospect_sql {
4352   " 0 = ( $select_count_pkgs ) ";
4353 }
4354
4355 =item ordered_sql
4356
4357 Returns an SQL expression identifying ordered cust_main records (customers with
4358 no active packages, but recurring packages not yet setup or one time charges
4359 not yet billed).
4360
4361 =cut
4362
4363 sub ordered_sql {
4364   FS::cust_main->none_active_sql.
4365   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4366 }
4367
4368 =item active_sql
4369
4370 Returns an SQL expression identifying active cust_main records (customers with
4371 active recurring packages).
4372
4373 =cut
4374
4375 sub active_sql {
4376   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4377 }
4378
4379 =item none_active_sql
4380
4381 Returns an SQL expression identifying cust_main records with no active
4382 recurring packages.  This includes customers of status prospect, ordered,
4383 inactive, and suspended.
4384
4385 =cut
4386
4387 sub none_active_sql {
4388   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4389 }
4390
4391 =item inactive_sql
4392
4393 Returns an SQL expression identifying inactive cust_main records (customers with
4394 no active recurring packages, but otherwise unsuspended/uncancelled).
4395
4396 =cut
4397
4398 sub inactive_sql {
4399   FS::cust_main->none_active_sql.
4400   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4401 }
4402
4403 =item susp_sql
4404 =item suspended_sql
4405
4406 Returns an SQL expression identifying suspended cust_main records.
4407
4408 =cut
4409
4410
4411 sub suspended_sql { susp_sql(@_); }
4412 sub susp_sql {
4413   FS::cust_main->none_active_sql.
4414   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4415 }
4416
4417 =item cancel_sql
4418 =item cancelled_sql
4419
4420 Returns an SQL expression identifying cancelled cust_main records.
4421
4422 =cut
4423
4424 sub cancel_sql { shift->cancelled_sql(@_); }
4425
4426 =item uncancel_sql
4427 =item uncancelled_sql
4428
4429 Returns an SQL expression identifying un-cancelled cust_main records.
4430
4431 =cut
4432
4433 sub uncancelled_sql { uncancel_sql(@_); }
4434 sub uncancel_sql { "
4435   ( 0 < ( $select_count_pkgs
4436                    AND ( cust_pkg.cancel IS NULL
4437                          OR cust_pkg.cancel = 0
4438                        )
4439         )
4440     OR 0 = ( $select_count_pkgs )
4441   )
4442 "; }
4443
4444 =item balance_sql
4445
4446 Returns an SQL fragment to retreive the balance.
4447
4448 =cut
4449
4450 sub balance_sql { "
4451     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4452         WHERE cust_bill.custnum   = cust_main.custnum     )
4453   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4454         WHERE cust_pay.custnum    = cust_main.custnum     )
4455   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4456         WHERE cust_credit.custnum = cust_main.custnum     )
4457   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4458         WHERE cust_refund.custnum = cust_main.custnum     )
4459 "; }
4460
4461 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4462
4463 Returns an SQL fragment to retreive the balance for this customer, optionally
4464 considering invoices with date earlier than START_TIME, and not
4465 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4466 total_unapplied_payments).
4467
4468 Times are specified as SQL fragments or numeric
4469 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4470 L<Date::Parse> for conversion functions.  The empty string can be passed
4471 to disable that time constraint completely.
4472
4473 Available options are:
4474
4475 =over 4
4476
4477 =item unapplied_date
4478
4479 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)
4480
4481 =item total
4482
4483 (unused.  obsolete?)
4484 set to true to remove all customer comparison clauses, for totals
4485
4486 =item where
4487
4488 (unused.  obsolete?)
4489 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4490
4491 =item join
4492
4493 (unused.  obsolete?)
4494 JOIN clause (typically used with the total option)
4495
4496 =item cutoff
4497
4498 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4499 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4500 range for invoices and I<unapplied> payments, credits, and refunds.
4501
4502 =back
4503
4504 =cut
4505
4506 sub balance_date_sql {
4507   my( $class, $start, $end, %opt ) = @_;
4508
4509   my $cutoff = $opt{'cutoff'};
4510
4511   my $owed         = FS::cust_bill->owed_sql($cutoff);
4512   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4513   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4514   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4515
4516   my $j = $opt{'join'} || '';
4517
4518   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4519   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4520   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4521   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4522
4523   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4524     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4525     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4526     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4527   ";
4528
4529 }
4530
4531 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4532
4533 Returns an SQL fragment to retreive the total unapplied payments for this
4534 customer, only considering payments with date earlier than START_TIME, and
4535 optionally not later than END_TIME.
4536
4537 Times are specified as SQL fragments or numeric
4538 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4539 L<Date::Parse> for conversion functions.  The empty string can be passed
4540 to disable that time constraint completely.
4541
4542 Available options are:
4543
4544 =cut
4545
4546 sub unapplied_payments_date_sql {
4547   my( $class, $start, $end, %opt ) = @_;
4548
4549   my $cutoff = $opt{'cutoff'};
4550
4551   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4552
4553   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4554                                                           'unapplied_date'=>1 );
4555
4556   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4557 }
4558
4559 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4560
4561 Helper method for balance_date_sql; name (and usage) subject to change
4562 (suggestions welcome).
4563
4564 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4565 cust_refund, cust_credit or cust_pay).
4566
4567 If TABLE is "cust_bill" or the unapplied_date option is true, only
4568 considers records with date earlier than START_TIME, and optionally not
4569 later than END_TIME .
4570
4571 =cut
4572
4573 sub _money_table_where {
4574   my( $class, $table, $start, $end, %opt ) = @_;
4575
4576   my @where = ();
4577   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4578   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4579     push @where, "$table._date <= $start" if defined($start) && length($start);
4580     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4581   }
4582   push @where, @{$opt{'where'}} if $opt{'where'};
4583   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4584
4585   $where;
4586
4587 }
4588
4589 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4590 use FS::cust_main::Search;
4591 sub search {
4592   my $class = shift;
4593   FS::cust_main::Search->search(@_);
4594 }
4595
4596 =back
4597
4598 =head1 SUBROUTINES
4599
4600 =over 4
4601
4602 =item batch_charge
4603
4604 =cut
4605
4606 sub batch_charge {
4607   my $param = shift;
4608   #warn join('-',keys %$param);
4609   my $fh = $param->{filehandle};
4610   my $agentnum = $param->{agentnum};
4611   my $format = $param->{format};
4612
4613   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4614
4615   my @fields;
4616   if ( $format eq 'simple' ) {
4617     @fields = qw( custnum agent_custid amount pkg );
4618   } else {
4619     die "unknown format $format";
4620   }
4621
4622   eval "use Text::CSV_XS;";
4623   die $@ if $@;
4624
4625   my $csv = new Text::CSV_XS;
4626   #warn $csv;
4627   #warn $fh;
4628
4629   my $imported = 0;
4630   #my $columns;
4631
4632   local $SIG{HUP} = 'IGNORE';
4633   local $SIG{INT} = 'IGNORE';
4634   local $SIG{QUIT} = 'IGNORE';
4635   local $SIG{TERM} = 'IGNORE';
4636   local $SIG{TSTP} = 'IGNORE';
4637   local $SIG{PIPE} = 'IGNORE';
4638
4639   my $oldAutoCommit = $FS::UID::AutoCommit;
4640   local $FS::UID::AutoCommit = 0;
4641   my $dbh = dbh;
4642
4643   #while ( $columns = $csv->getline($fh) ) {
4644   my $line;
4645   while ( defined($line=<$fh>) ) {
4646
4647     $csv->parse($line) or do {
4648       $dbh->rollback if $oldAutoCommit;
4649       return "can't parse: ". $csv->error_input();
4650     };
4651
4652     my @columns = $csv->fields();
4653     #warn join('-',@columns);
4654
4655     my %row = ();
4656     foreach my $field ( @fields ) {
4657       $row{$field} = shift @columns;
4658     }
4659
4660     if ( $row{custnum} && $row{agent_custid} ) {
4661       dbh->rollback if $oldAutoCommit;
4662       return "can't specify custnum with agent_custid $row{agent_custid}";
4663     }
4664
4665     my %hash = ();
4666     if ( $row{agent_custid} && $agentnum ) {
4667       %hash = ( 'agent_custid' => $row{agent_custid},
4668                 'agentnum'     => $agentnum,
4669               );
4670     }
4671
4672     if ( $row{custnum} ) {
4673       %hash = ( 'custnum' => $row{custnum} );
4674     }
4675
4676     unless ( scalar(keys %hash) ) {
4677       $dbh->rollback if $oldAutoCommit;
4678       return "can't find customer without custnum or agent_custid and agentnum";
4679     }
4680
4681     my $cust_main = qsearchs('cust_main', { %hash } );
4682     unless ( $cust_main ) {
4683       $dbh->rollback if $oldAutoCommit;
4684       my $custnum = $row{custnum} || $row{agent_custid};
4685       return "unknown custnum $custnum";
4686     }
4687
4688     if ( $row{'amount'} > 0 ) {
4689       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4690       if ( $error ) {
4691         $dbh->rollback if $oldAutoCommit;
4692         return $error;
4693       }
4694       $imported++;
4695     } elsif ( $row{'amount'} < 0 ) {
4696       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4697                                       $row{'pkg'}                         );
4698       if ( $error ) {
4699         $dbh->rollback if $oldAutoCommit;
4700         return $error;
4701       }
4702       $imported++;
4703     } else {
4704       #hmm?
4705     }
4706
4707   }
4708
4709   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4710
4711   return "Empty file!" unless $imported;
4712
4713   ''; #no error
4714
4715 }
4716
4717 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4718
4719 Deprecated.  Use event notification and message templates
4720 (L<FS::msg_template>) instead.
4721
4722 Sends a templated email notification to the customer (see L<Text::Template>).
4723
4724 OPTIONS is a hash and may include
4725
4726 I<from> - the email sender (default is invoice_from)
4727
4728 I<to> - comma-separated scalar or arrayref of recipients
4729    (default is invoicing_list)
4730
4731 I<subject> - The subject line of the sent email notification
4732    (default is "Notice from company_name")
4733
4734 I<extra_fields> - a hashref of name/value pairs which will be substituted
4735    into the template
4736
4737 The following variables are vavailable in the template.
4738
4739 I<$first> - the customer first name
4740 I<$last> - the customer last name
4741 I<$company> - the customer company
4742 I<$payby> - a description of the method of payment for the customer
4743             # would be nice to use FS::payby::shortname
4744 I<$payinfo> - the account information used to collect for this customer
4745 I<$expdate> - the expiration of the customer payment in seconds from epoch
4746
4747 =cut
4748
4749 sub notify {
4750   my ($self, $template, %options) = @_;
4751
4752   return unless $conf->exists($template);
4753
4754   my $from = $conf->config('invoice_from', $self->agentnum)
4755     if $conf->exists('invoice_from', $self->agentnum);
4756   $from = $options{from} if exists($options{from});
4757
4758   my $to = join(',', $self->invoicing_list_emailonly);
4759   $to = $options{to} if exists($options{to});
4760
4761   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4762     if $conf->exists('company_name', $self->agentnum);
4763   $subject = $options{subject} if exists($options{subject});
4764
4765   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4766                                             SOURCE => [ map "$_\n",
4767                                               $conf->config($template)]
4768                                            )
4769     or die "can't create new Text::Template object: Text::Template::ERROR";
4770   $notify_template->compile()
4771     or die "can't compile template: Text::Template::ERROR";
4772
4773   $FS::notify_template::_template::company_name =
4774     $conf->config('company_name', $self->agentnum);
4775   $FS::notify_template::_template::company_address =
4776     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4777
4778   my $paydate = $self->paydate || '2037-12-31';
4779   $FS::notify_template::_template::first = $self->first;
4780   $FS::notify_template::_template::last = $self->last;
4781   $FS::notify_template::_template::company = $self->company;
4782   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4783   my $payby = $self->payby;
4784   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4785   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4786
4787   #credit cards expire at the end of the month/year of their exp date
4788   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4789     $FS::notify_template::_template::payby = 'credit card';
4790     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4791     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4792     $expire_time--;
4793   }elsif ($payby eq 'COMP') {
4794     $FS::notify_template::_template::payby = 'complimentary account';
4795   }else{
4796     $FS::notify_template::_template::payby = 'current method';
4797   }
4798   $FS::notify_template::_template::expdate = $expire_time;
4799
4800   for (keys %{$options{extra_fields}}){
4801     no strict "refs";
4802     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4803   }
4804
4805   send_email(from => $from,
4806              to => $to,
4807              subject => $subject,
4808              body => $notify_template->fill_in( PACKAGE =>
4809                                                 'FS::notify_template::_template'                                              ),
4810             );
4811
4812 }
4813
4814 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4815
4816 Generates a templated notification to the customer (see L<Text::Template>).
4817
4818 OPTIONS is a hash and may include
4819
4820 I<extra_fields> - a hashref of name/value pairs which will be substituted
4821    into the template.  These values may override values mentioned below
4822    and those from the customer record.
4823
4824 The following variables are available in the template instead of or in addition
4825 to the fields of the customer record.
4826
4827 I<$payby> - a description of the method of payment for the customer
4828             # would be nice to use FS::payby::shortname
4829 I<$payinfo> - the masked account information used to collect for this customer
4830 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4831 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4832
4833 =cut
4834
4835 # a lot like cust_bill::print_latex
4836 sub generate_letter {
4837   my ($self, $template, %options) = @_;
4838
4839   return unless $conf->exists($template);
4840
4841   my $letter_template = new Text::Template
4842                         ( TYPE       => 'ARRAY',
4843                           SOURCE     => [ map "$_\n", $conf->config($template)],
4844                           DELIMITERS => [ '[@--', '--@]' ],
4845                         )
4846     or die "can't create new Text::Template object: Text::Template::ERROR";
4847
4848   $letter_template->compile()
4849     or die "can't compile template: Text::Template::ERROR";
4850
4851   my %letter_data = map { $_ => $self->$_ } $self->fields;
4852   $letter_data{payinfo} = $self->mask_payinfo;
4853
4854   #my $paydate = $self->paydate || '2037-12-31';
4855   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4856
4857   my $payby = $self->payby;
4858   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4859   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4860
4861   #credit cards expire at the end of the month/year of their exp date
4862   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4863     $letter_data{payby} = 'credit card';
4864     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4865     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4866     $expire_time--;
4867   }elsif ($payby eq 'COMP') {
4868     $letter_data{payby} = 'complimentary account';
4869   }else{
4870     $letter_data{payby} = 'current method';
4871   }
4872   $letter_data{expdate} = $expire_time;
4873
4874   for (keys %{$options{extra_fields}}){
4875     $letter_data{$_} = $options{extra_fields}->{$_};
4876   }
4877
4878   unless(exists($letter_data{returnaddress})){
4879     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4880                                                   $self->agent_template)
4881                      );
4882     if ( length($retadd) ) {
4883       $letter_data{returnaddress} = $retadd;
4884     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4885       $letter_data{returnaddress} =
4886         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4887                           s/$/\\\\\*/;
4888                           $_;
4889                         }
4890                     ( $conf->config('company_name', $self->agentnum),
4891                       $conf->config('company_address', $self->agentnum),
4892                     )
4893         );
4894     } else {
4895       $letter_data{returnaddress} = '~';
4896     }
4897   }
4898
4899   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4900
4901   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4902
4903   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4904
4905   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4906                            DIR      => $dir,
4907                            SUFFIX   => '.eps',
4908                            UNLINK   => 0,
4909                          ) or die "can't open temp file: $!\n";
4910   print $lh $conf->config_binary('logo.eps', $self->agentnum)
4911     or die "can't write temp file: $!\n";
4912   close $lh;
4913   $letter_data{'logo_file'} = $lh->filename;
4914
4915   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4916                            DIR      => $dir,
4917                            SUFFIX   => '.tex',
4918                            UNLINK   => 0,
4919                          ) or die "can't open temp file: $!\n";
4920
4921   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4922   close $fh;
4923   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4924   return ($1, $letter_data{'logo_file'});
4925
4926 }
4927
4928 =item print_ps TEMPLATE
4929
4930 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4931
4932 =cut
4933
4934 sub print_ps {
4935   my $self = shift;
4936   my($file, $lfile) = $self->generate_letter(@_);
4937   my $ps = FS::Misc::generate_ps($file);
4938   unlink($file.'.tex');
4939   unlink($lfile);
4940
4941   $ps;
4942 }
4943
4944 =item print TEMPLATE
4945
4946 Prints the filled in template.
4947
4948 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4949
4950 =cut
4951
4952 sub queueable_print {
4953   my %opt = @_;
4954
4955   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4956     or die "invalid customer number: " . $opt{custnum};
4957
4958   my $error = $self->print( { 'template' => $opt{template} } );
4959   die $error if $error;
4960 }
4961
4962 sub print {
4963   my ($self, $template) = (shift, shift);
4964   do_print(
4965     [ $self->print_ps($template) ],
4966     'agentnum' => $self->agentnum,
4967   );
4968 }
4969
4970 #these three subs should just go away once agent stuff is all config overrides
4971
4972 sub agent_template {
4973   my $self = shift;
4974   $self->_agent_plandata('agent_templatename');
4975 }
4976
4977 sub agent_invoice_from {
4978   my $self = shift;
4979   $self->_agent_plandata('agent_invoice_from');
4980 }
4981
4982 sub _agent_plandata {
4983   my( $self, $option ) = @_;
4984
4985   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
4986   #agent-specific Conf
4987
4988   use FS::part_event::Condition;
4989
4990   my $agentnum = $self->agentnum;
4991
4992   my $regexp = regexp_sql();
4993
4994   my $part_event_option =
4995     qsearchs({
4996       'select'    => 'part_event_option.*',
4997       'table'     => 'part_event_option',
4998       'addl_from' => q{
4999         LEFT JOIN part_event USING ( eventpart )
5000         LEFT JOIN part_event_option AS peo_agentnum
5001           ON ( part_event.eventpart = peo_agentnum.eventpart
5002                AND peo_agentnum.optionname = 'agentnum'
5003                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5004              )
5005         LEFT JOIN part_event_condition
5006           ON ( part_event.eventpart = part_event_condition.eventpart
5007                AND part_event_condition.conditionname = 'cust_bill_age'
5008              )
5009         LEFT JOIN part_event_condition_option
5010           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5011                AND part_event_condition_option.optionname = 'age'
5012              )
5013       },
5014       #'hashref'   => { 'optionname' => $option },
5015       #'hashref'   => { 'part_event_option.optionname' => $option },
5016       'extra_sql' =>
5017         " WHERE part_event_option.optionname = ". dbh->quote($option).
5018         " AND action = 'cust_bill_send_agent' ".
5019         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5020         " AND peo_agentnum.optionname = 'agentnum' ".
5021         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5022         " ORDER BY
5023            CASE WHEN part_event_condition_option.optionname IS NULL
5024            THEN -1
5025            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5026         " END
5027           , part_event.weight".
5028         " LIMIT 1"
5029     });
5030
5031   unless ( $part_event_option ) {
5032     return $self->agent->invoice_template || ''
5033       if $option eq 'agent_templatename';
5034     return '';
5035   }
5036
5037   $part_event_option->optionvalue;
5038
5039 }
5040
5041 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5042
5043 Subroutine (not a method), designed to be called from the queue.
5044
5045 Takes a list of options and values.
5046
5047 Pulls up the customer record via the custnum option and calls bill_and_collect.
5048
5049 =cut
5050
5051 sub queued_bill {
5052   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5053
5054   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5055   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5056
5057   #without this errors don't get rolled back
5058   $args{'fatal'} = 1; # runs from job queue, will be caught
5059
5060   $cust_main->bill_and_collect( %args );
5061 }
5062
5063 sub process_bill_and_collect {
5064   my $job = shift;
5065   my $param = thaw(decode_base64(shift));
5066   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5067       or die "custnum '$param->{custnum}' not found!\n";
5068   $param->{'job'}   = $job;
5069   $param->{'fatal'} = 1; # runs from job queue, will be caught
5070   $param->{'retry'} = 1;
5071
5072   $cust_main->bill_and_collect( %$param );
5073 }
5074
5075 #starting to take quite a while for big dbs
5076 #   (JRNL: journaled so it only happens once per database)
5077 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5078 # JRNL seq scan of cust_main on signupdate... index signupdate?  will that help?
5079 # JRNL seq scan of cust_main on paydate... index on substrings?  maybe set an
5080 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5081 # JRNL leading/trailing spaces in first, last, company
5082 # - otaker upgrade?  journal and call it good?  (double check to make sure
5083 #    we're not still setting otaker here)
5084 #
5085 #only going to get worse with new location stuff...
5086
5087 sub _upgrade_data { #class method
5088   my ($class, %opts) = @_;
5089
5090   my @statements = (
5091     'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5092   );
5093
5094   #this seems to be the only expensive one.. why does it take so long?
5095   unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5096     push @statements,
5097       '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';
5098     FS::upgrade_journal->set_done('cust_main__signupdate');
5099   }
5100
5101   unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5102
5103     # fix yyyy-m-dd formatted paydates
5104     if ( driver_name =~ /^mysql/i ) {
5105       push @statements,
5106       "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5107     } else { # the SQL standard
5108       push @statements,
5109       "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5110     }
5111     FS::upgrade_journal->set_done('cust_main__paydate');
5112   }
5113
5114   unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5115
5116     push @statements, #fix the weird BILL with a cc# in payinfo problem
5117       #DCRD to be safe
5118       "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5119
5120     FS::upgrade_journal->set_done('cust_main__payinfo');
5121
5122   }
5123
5124   my $t = time;
5125   foreach my $sql ( @statements ) {
5126     my $sth = dbh->prepare($sql) or die dbh->errstr;
5127     $sth->execute or die $sth->errstr;
5128     #warn ( (time - $t). " seconds\n" );
5129     #$t = time;
5130   }
5131
5132   local($ignore_expired_card) = 1;
5133   local($ignore_banned_card) = 1;
5134   local($skip_fuzzyfiles) = 1;
5135   local($import) = 1; #prevent automatic geocoding (need its own variable?)
5136
5137   FS::cust_main::Location->_upgrade_data(%opts);
5138
5139   unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5140
5141     foreach my $cust_main ( qsearch({
5142       'table'     => 'cust_main',
5143       'hashref'   => {},
5144       'extra_sql' => 'WHERE '.
5145                        join(' OR ',
5146                          map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '%  %'",
5147                            qw( first last company )
5148                        ),
5149     }) ) {
5150       my $error = $cust_main->replace;
5151       die $error if $error;
5152     }
5153
5154     FS::upgrade_journal->set_done('cust_main__trimspaces');
5155
5156   }
5157
5158   $class->_upgrade_otaker(%opts);
5159
5160 }
5161
5162 =back
5163
5164 =head1 BUGS
5165
5166 The delete method.
5167
5168 The delete method should possibly take an FS::cust_main object reference
5169 instead of a scalar customer number.
5170
5171 Bill and collect options should probably be passed as references instead of a
5172 list.
5173
5174 There should probably be a configuration file with a list of allowed credit
5175 card types.
5176
5177 No multiple currency support (probably a larger project than just this module).
5178
5179 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5180
5181 Birthdates rely on negative epoch values.
5182
5183 The payby for card/check batches is broken.  With mixed batching, bad
5184 things will happen.
5185
5186 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5187
5188 =head1 SEE ALSO
5189
5190 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5191 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5192 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5193
5194 =cut
5195
5196 1;
5197