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