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