FS/FS/cust_main.pm

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