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