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')) 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'));
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')
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')
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 svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3708
3709 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3710
3711 Optionally, a list or hashref of additional arguments to the qsearch call can
3712 be passed following the SVCDB.
3713
3714 =cut
3715
3716 sub svc_x {
3717   my $self = shift;
3718   my $svcdb = shift;
3719   if ( ! $svcdb =~ /^svc_\w+$/ ) {
3720     warn "$me svc_x requires a svcdb";
3721     return;
3722   }
3723   my $opt = ref($_[0]) ? shift : { @_ };
3724
3725   $opt->{'table'} = $svcdb;
3726   $opt->{'addl_from'} =
3727     'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3728     ($opt->{'addl_from'} || '');
3729
3730   my $custnum = $self->custnum;
3731   $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3732   my $where = "cust_pkg.custnum = $custnum";
3733
3734   my $extra_sql = $opt->{'extra_sql'} || '';
3735   if ( keys %{ $opt->{'hashref'} } ) {
3736     $extra_sql = " AND $where $extra_sql";
3737   }
3738   else {
3739     if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3740       $extra_sql = "WHERE $where AND $1";
3741     }
3742     else {
3743       $extra_sql = "WHERE $where $extra_sql";
3744     }
3745   }
3746   $opt->{'extra_sql'} = $extra_sql;
3747
3748   qsearch($opt);
3749 }
3750
3751 # required for use as an eventtable;
3752 sub svc_acct {
3753   my $self = shift;
3754   $self->svc_x('svc_acct', @_);
3755 }
3756
3757 =item cust_credit
3758
3759 Returns all the credits (see L<FS::cust_credit>) for this customer.
3760
3761 =cut
3762
3763 sub cust_credit {
3764   my $self = shift;
3765   map { $_ } #return $self->num_cust_credit unless wantarray;
3766   sort { $a->_date <=> $b->_date }
3767     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3768 }
3769
3770 =item cust_credit_pkgnum
3771
3772 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3773 package when using experimental package balances.
3774
3775 =cut
3776
3777 sub cust_credit_pkgnum {
3778   my( $self, $pkgnum ) = @_;
3779   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3780   sort { $a->_date <=> $b->_date }
3781     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3782                               'pkgnum'  => $pkgnum,
3783                             }
3784     );
3785 }
3786
3787 =item cust_pay
3788
3789 Returns all the payments (see L<FS::cust_pay>) for this customer.
3790
3791 =cut
3792
3793 sub cust_pay {
3794   my $self = shift;
3795   return $self->num_cust_pay unless wantarray;
3796   sort { $a->_date <=> $b->_date }
3797     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3798 }
3799
3800 =item num_cust_pay
3801
3802 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3803 called automatically when the cust_pay method is used in a scalar context.
3804
3805 =cut
3806
3807 sub num_cust_pay {
3808   my $self = shift;
3809   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3810   my $sth = dbh->prepare($sql) or die dbh->errstr;
3811   $sth->execute($self->custnum) or die $sth->errstr;
3812   $sth->fetchrow_arrayref->[0];
3813 }
3814
3815 =item cust_pay_pkgnum
3816
3817 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3818 package when using experimental package balances.
3819
3820 =cut
3821
3822 sub cust_pay_pkgnum {
3823   my( $self, $pkgnum ) = @_;
3824   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3825   sort { $a->_date <=> $b->_date }
3826     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3827                            'pkgnum'  => $pkgnum,
3828                          }
3829     );
3830 }
3831
3832 =item cust_pay_void
3833
3834 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3835
3836 =cut
3837
3838 sub cust_pay_void {
3839   my $self = shift;
3840   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3841   sort { $a->_date <=> $b->_date }
3842     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3843 }
3844
3845 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3846
3847 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
3848
3849 Optionally, a list or hashref of additional arguments to the qsearch call can
3850 be passed.
3851
3852 =cut
3853
3854 sub cust_pay_batch {
3855   my $self = shift;
3856   my $opt = ref($_[0]) ? shift : { @_ };
3857
3858   #return $self->num_cust_statement unless wantarray || keys %$opt;
3859
3860   $opt->{'table'} = 'cust_pay_batch';
3861   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3862   $opt->{'hashref'}{'custnum'} = $self->custnum;
3863   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3864
3865   map { $_ } #behavior of sort undefined in scalar context
3866     sort { $a->paybatchnum <=> $b->paybatchnum }
3867       qsearch($opt);
3868 }
3869
3870 =item cust_pay_pending
3871
3872 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3873 (without status "done").
3874
3875 =cut
3876
3877 sub cust_pay_pending {
3878   my $self = shift;
3879   return $self->num_cust_pay_pending unless wantarray;
3880   sort { $a->_date <=> $b->_date }
3881     qsearch( 'cust_pay_pending', {
3882                                    'custnum' => $self->custnum,
3883                                    'status'  => { op=>'!=', value=>'done' },
3884                                  },
3885            );
3886 }
3887
3888 =item cust_pay_pending_attempt
3889
3890 Returns all payment attempts / declined payments for this customer, as pending
3891 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3892 a corresponding payment (see L<FS::cust_pay>).
3893
3894 =cut
3895
3896 sub cust_pay_pending_attempt {
3897   my $self = shift;
3898   return $self->num_cust_pay_pending_attempt unless wantarray;
3899   sort { $a->_date <=> $b->_date }
3900     qsearch( 'cust_pay_pending', {
3901                                    'custnum' => $self->custnum,
3902                                    'status'  => 'done',
3903                                    'paynum'  => '',
3904                                  },
3905            );
3906 }
3907
3908 =item num_cust_pay_pending
3909
3910 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3911 customer (without status "done").  Also called automatically when the
3912 cust_pay_pending method is used in a scalar context.
3913
3914 =cut
3915
3916 sub num_cust_pay_pending {
3917   my $self = shift;
3918   $self->scalar_sql(
3919     " SELECT COUNT(*) FROM cust_pay_pending ".
3920       " WHERE custnum = ? AND status != 'done' ",
3921     $self->custnum
3922   );
3923 }
3924
3925 =item num_cust_pay_pending_attempt
3926
3927 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3928 customer, with status "done" but without a corresp.  Also called automatically when the
3929 cust_pay_pending method is used in a scalar context.
3930
3931 =cut
3932
3933 sub num_cust_pay_pending_attempt {
3934   my $self = shift;
3935   $self->scalar_sql(
3936     " SELECT COUNT(*) FROM cust_pay_pending ".
3937       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3938     $self->custnum
3939   );
3940 }
3941
3942 =item cust_refund
3943
3944 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3945
3946 =cut
3947
3948 sub cust_refund {
3949   my $self = shift;
3950   map { $_ } #return $self->num_cust_refund unless wantarray;
3951   sort { $a->_date <=> $b->_date }
3952     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3953 }
3954
3955 =item display_custnum
3956
3957 Returns the displayed customer number for this customer: agent_custid if
3958 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3959
3960 =cut
3961
3962 sub display_custnum {
3963   my $self = shift;
3964   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
3965     return $self->agent_custid;
3966   } elsif ( $conf->config('cust_main-custnum-display_prefix') ) {
3967     return $conf->config('cust_main-custnum-display_prefix').
3968            sprintf('%08d', $self->custnum)
3969   } else {
3970     return $self->custnum;
3971   }
3972 }
3973
3974 =item name
3975
3976 Returns a name string for this customer, either "Company (Last, First)" or
3977 "Last, First".
3978
3979 =cut
3980
3981 sub name {
3982   my $self = shift;
3983   my $name = $self->contact;
3984   $name = $self->company. " ($name)" if $self->company;
3985   $name;
3986 }
3987
3988 =item ship_name
3989
3990 Returns a name string for this (service/shipping) contact, either
3991 "Company (Last, First)" or "Last, First".
3992
3993 =cut
3994
3995 sub ship_name {
3996   my $self = shift;
3997   if ( $self->get('ship_last') ) {
3998     my $name = $self->ship_contact;
3999     $name = $self->ship_company. " ($name)" if $self->ship_company;
4000     $name;
4001   } else {
4002     $self->name;
4003   }
4004 }
4005
4006 =item name_short
4007
4008 Returns a name string for this customer, either "Company" or "First Last".
4009
4010 =cut
4011
4012 sub name_short {
4013   my $self = shift;
4014   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4015 }
4016
4017 =item ship_name_short
4018
4019 Returns a name string for this (service/shipping) contact, either "Company"
4020 or "First Last".
4021
4022 =cut
4023
4024 sub ship_name_short {
4025   my $self = shift;
4026   if ( $self->get('ship_last') ) {
4027     $self->ship_company !~ /^\s*$/
4028       ? $self->ship_company
4029       : $self->ship_contact_firstlast;
4030   } else {
4031     $self->name_company_or_firstlast;
4032   }
4033 }
4034
4035 =item contact
4036
4037 Returns this customer's full (billing) contact name only, "Last, First"
4038
4039 =cut
4040
4041 sub contact {
4042   my $self = shift;
4043   $self->get('last'). ', '. $self->first;
4044 }
4045
4046 =item ship_contact
4047
4048 Returns this customer's full (shipping) contact name only, "Last, First"
4049
4050 =cut
4051
4052 sub ship_contact {
4053   my $self = shift;
4054   $self->get('ship_last')
4055     ? $self->get('ship_last'). ', '. $self->ship_first
4056     : $self->contact;
4057 }
4058
4059 =item contact_firstlast
4060
4061 Returns this customers full (billing) contact name only, "First Last".
4062
4063 =cut
4064
4065 sub contact_firstlast {
4066   my $self = shift;
4067   $self->first. ' '. $self->get('last');
4068 }
4069
4070 =item ship_contact_firstlast
4071
4072 Returns this customer's full (shipping) contact name only, "First Last".
4073
4074 =cut
4075
4076 sub ship_contact_firstlast {
4077   my $self = shift;
4078   $self->get('ship_last')
4079     ? $self->first. ' '. $self->get('ship_last')
4080     : $self->contact_firstlast;
4081 }
4082
4083 =item country_full
4084
4085 Returns this customer's full country name
4086
4087 =cut
4088
4089 sub country_full {
4090   my $self = shift;
4091   code2country($self->country);
4092 }
4093
4094 =item geocode DATA_VENDOR
4095
4096 Returns a value for the customer location as encoded by DATA_VENDOR.
4097 Currently this only makes sense for "CCH" as DATA_VENDOR.
4098
4099 =cut
4100
4101 =item cust_status
4102
4103 =item status
4104
4105 Returns a status string for this customer, currently:
4106
4107 =over 4
4108
4109 =item prospect - No packages have ever been ordered
4110
4111 =item ordered - Recurring packages all are new (not yet billed).
4112
4113 =item active - One or more recurring packages is active
4114
4115 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4116
4117 =item suspended - All non-cancelled recurring packages are suspended
4118
4119 =item cancelled - All recurring packages are cancelled
4120
4121 =back
4122
4123 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4124 cust_main-status_module configuration option.
4125
4126 =cut
4127
4128 sub status { shift->cust_status(@_); }
4129
4130 sub cust_status {
4131   my $self = shift;
4132   for my $status ( FS::cust_main->statuses() ) {
4133     my $method = $status.'_sql';
4134     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4135     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4136     $sth->execute( ($self->custnum) x $numnum )
4137       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4138     return $status if $sth->fetchrow_arrayref->[0];
4139   }
4140 }
4141
4142 =item ucfirst_cust_status
4143
4144 =item ucfirst_status
4145
4146 Returns the status with the first character capitalized.
4147
4148 =cut
4149
4150 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4151
4152 sub ucfirst_cust_status {
4153   my $self = shift;
4154   ucfirst($self->cust_status);
4155 }
4156
4157 =item statuscolor
4158
4159 Returns a hex triplet color string for this customer's status.
4160
4161 =cut
4162
4163 sub statuscolor { shift->cust_statuscolor(@_); }
4164
4165 sub cust_statuscolor {
4166   my $self = shift;
4167   __PACKAGE__->statuscolors->{$self->cust_status};
4168 }
4169
4170 =item tickets
4171
4172 Returns an array of hashes representing the customer's RT tickets.
4173
4174 =cut
4175
4176 sub tickets {
4177   my $self = shift;
4178
4179   my $num = $conf->config('cust_main-max_tickets') || 10;
4180   my @tickets = ();
4181
4182   if ( $conf->config('ticket_system') ) {
4183     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4184
4185       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
4186
4187     } else {
4188
4189       foreach my $priority (
4190         $conf->config('ticket_system-custom_priority_field-values'), ''
4191       ) {
4192         last if scalar(@tickets) >= $num;
4193         push @tickets,
4194           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4195                                                  $num - scalar(@tickets),
4196                                                  $priority,
4197                                                )
4198            };
4199       }
4200     }
4201   }
4202   (@tickets);
4203 }
4204
4205 # Return services representing svc_accts in customer support packages
4206 sub support_services {
4207   my $self = shift;
4208   my %packages = map { $_ => 1 } $conf->config('support_packages');
4209
4210   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4211     grep { $_->part_svc->svcdb eq 'svc_acct' }
4212     map { $_->cust_svc }
4213     grep { exists $packages{ $_->pkgpart } }
4214     $self->ncancelled_pkgs;
4215
4216 }
4217
4218 # Return a list of latitude/longitude for one of the services (if any)
4219 sub service_coordinates {
4220   my $self = shift;
4221
4222   my @svc_X =
4223     grep { $_->latitude && $_->longitude }
4224     map { $_->svc_x }
4225     map { $_->cust_svc }
4226     $self->ncancelled_pkgs;
4227
4228   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4229 }
4230
4231 =item masked FIELD
4232
4233 Returns a masked version of the named field
4234
4235 =cut
4236
4237 sub masked {
4238 my ($self,$field) = @_;
4239
4240 # Show last four
4241
4242 'x'x(length($self->getfield($field))-4).
4243   substr($self->getfield($field), (length($self->getfield($field))-4));
4244
4245 }
4246
4247 =back
4248
4249 =head1 CLASS METHODS
4250
4251 =over 4
4252
4253 =item statuses
4254
4255 Class method that returns the list of possible status strings for customers
4256 (see L<the status method|/status>).  For example:
4257
4258   @statuses = FS::cust_main->statuses();
4259
4260 =cut
4261
4262 sub statuses {
4263   my $self = shift;
4264   keys %{ $self->statuscolors };
4265 }
4266
4267 =item cust_status_sql
4268
4269 Returns an SQL fragment to determine the status of a cust_main record, as a
4270 string.
4271
4272 =cut
4273
4274 sub cust_status_sql {
4275   my $sql = 'CASE';
4276   for my $status ( FS::cust_main->statuses() ) {
4277     my $method = $status.'_sql';
4278     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4279   }
4280   $sql .= ' END';
4281   return $sql;
4282 }
4283
4284
4285 =item prospect_sql
4286
4287 Returns an SQL expression identifying prospective cust_main records (customers
4288 with no packages ever ordered)
4289
4290 =cut
4291
4292 use vars qw($select_count_pkgs);
4293 $select_count_pkgs =
4294   "SELECT COUNT(*) FROM cust_pkg
4295     WHERE cust_pkg.custnum = cust_main.custnum";
4296
4297 sub select_count_pkgs_sql {
4298   $select_count_pkgs;
4299 }
4300
4301 sub prospect_sql {
4302   " 0 = ( $select_count_pkgs ) ";
4303 }
4304
4305 =item ordered_sql
4306
4307 Returns an SQL expression identifying ordered cust_main records (customers with
4308 no active packages, but recurring packages not yet setup or one time charges
4309 not yet billed).
4310
4311 =cut
4312
4313 sub ordered_sql {
4314   FS::cust_main->none_active_sql.
4315   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4316 }
4317
4318 =item active_sql
4319
4320 Returns an SQL expression identifying active cust_main records (customers with
4321 active recurring packages).
4322
4323 =cut
4324
4325 sub active_sql {
4326   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4327 }
4328
4329 =item none_active_sql
4330
4331 Returns an SQL expression identifying cust_main records with no active
4332 recurring packages.  This includes customers of status prospect, ordered,
4333 inactive, and suspended.
4334
4335 =cut
4336
4337 sub none_active_sql {
4338   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4339 }
4340
4341 =item inactive_sql
4342
4343 Returns an SQL expression identifying inactive cust_main records (customers with
4344 no active recurring packages, but otherwise unsuspended/uncancelled).
4345
4346 =cut
4347
4348 sub inactive_sql {
4349   FS::cust_main->none_active_sql.
4350   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4351 }
4352
4353 =item susp_sql
4354 =item suspended_sql
4355
4356 Returns an SQL expression identifying suspended cust_main records.
4357
4358 =cut
4359
4360
4361 sub suspended_sql { susp_sql(@_); }
4362 sub susp_sql {
4363   FS::cust_main->none_active_sql.
4364   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4365 }
4366
4367 =item cancel_sql
4368 =item cancelled_sql
4369
4370 Returns an SQL expression identifying cancelled cust_main records.
4371
4372 =cut
4373
4374 sub cancel_sql { shift->cancelled_sql(@_); }
4375
4376 =item uncancel_sql
4377 =item uncancelled_sql
4378
4379 Returns an SQL expression identifying un-cancelled cust_main records.
4380
4381 =cut
4382
4383 sub uncancelled_sql { uncancel_sql(@_); }
4384 sub uncancel_sql { "
4385   ( 0 < ( $select_count_pkgs
4386                    AND ( cust_pkg.cancel IS NULL
4387                          OR cust_pkg.cancel = 0
4388                        )
4389         )
4390     OR 0 = ( $select_count_pkgs )
4391   )
4392 "; }
4393
4394 =item balance_sql
4395
4396 Returns an SQL fragment to retreive the balance.
4397
4398 =cut
4399
4400 sub balance_sql { "
4401     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4402         WHERE cust_bill.custnum   = cust_main.custnum     )
4403   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4404         WHERE cust_pay.custnum    = cust_main.custnum     )
4405   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4406         WHERE cust_credit.custnum = cust_main.custnum     )
4407   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4408         WHERE cust_refund.custnum = cust_main.custnum     )
4409 "; }
4410
4411 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4412
4413 Returns an SQL fragment to retreive the balance for this customer, optionally
4414 considering invoices with date earlier than START_TIME, and not
4415 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4416 total_unapplied_payments).
4417
4418 Times are specified as SQL fragments or numeric
4419 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4420 L<Date::Parse> for conversion functions.  The empty string can be passed
4421 to disable that time constraint completely.
4422
4423 Available options are:
4424
4425 =over 4
4426
4427 =item unapplied_date
4428
4429 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)
4430
4431 =item total
4432
4433 (unused.  obsolete?)
4434 set to true to remove all customer comparison clauses, for totals
4435
4436 =item where
4437
4438 (unused.  obsolete?)
4439 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4440
4441 =item join
4442
4443 (unused.  obsolete?)
4444 JOIN clause (typically used with the total option)
4445
4446 =item cutoff
4447
4448 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4449 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4450 range for invoices and I<unapplied> payments, credits, and refunds.
4451
4452 =back
4453
4454 =cut
4455
4456 sub balance_date_sql {
4457   my( $class, $start, $end, %opt ) = @_;
4458
4459   my $cutoff = $opt{'cutoff'};
4460
4461   my $owed         = FS::cust_bill->owed_sql($cutoff);
4462   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4463   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4464   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4465
4466   my $j = $opt{'join'} || '';
4467
4468   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4469   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4470   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4471   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4472
4473   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4474     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4475     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4476     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4477   ";
4478
4479 }
4480
4481 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4482
4483 Returns an SQL fragment to retreive the total unapplied payments for this
4484 customer, only considering payments with date earlier than START_TIME, and
4485 optionally not later than END_TIME.
4486
4487 Times are specified as SQL fragments or numeric
4488 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4489 L<Date::Parse> for conversion functions.  The empty string can be passed
4490 to disable that time constraint completely.
4491
4492 Available options are:
4493
4494 =cut
4495
4496 sub unapplied_payments_date_sql {
4497   my( $class, $start, $end, %opt ) = @_;
4498
4499   my $cutoff = $opt{'cutoff'};
4500
4501   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4502
4503   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4504                                                           'unapplied_date'=>1 );
4505
4506   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4507 }
4508
4509 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4510
4511 Helper method for balance_date_sql; name (and usage) subject to change
4512 (suggestions welcome).
4513
4514 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4515 cust_refund, cust_credit or cust_pay).
4516
4517 If TABLE is "cust_bill" or the unapplied_date option is true, only
4518 considers records with date earlier than START_TIME, and optionally not
4519 later than END_TIME .
4520
4521 =cut
4522
4523 sub _money_table_where {
4524   my( $class, $table, $start, $end, %opt ) = @_;
4525
4526   my @where = ();
4527   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4528   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4529     push @where, "$table._date <= $start" if defined($start) && length($start);
4530     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4531   }
4532   push @where, @{$opt{'where'}} if $opt{'where'};
4533   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4534
4535   $where;
4536
4537 }
4538
4539 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4540 use FS::cust_main::Search;
4541 sub search {
4542   my $class = shift;
4543   FS::cust_main::Search->search(@_);
4544 }
4545
4546 =back
4547
4548 =head1 SUBROUTINES
4549
4550 =over 4
4551
4552 =item batch_charge
4553
4554 =cut
4555
4556 sub batch_charge {
4557   my $param = shift;
4558   #warn join('-',keys %$param);
4559   my $fh = $param->{filehandle};
4560   my $agentnum = $param->{agentnum};
4561   my $format = $param->{format};
4562
4563   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4564
4565   my @fields;
4566   if ( $format eq 'simple' ) {
4567     @fields = qw( custnum agent_custid amount pkg );
4568   } else {
4569     die "unknown format $format";
4570   }
4571
4572   eval "use Text::CSV_XS;";
4573   die $@ if $@;
4574
4575   my $csv = new Text::CSV_XS;
4576   #warn $csv;
4577   #warn $fh;
4578
4579   my $imported = 0;
4580   #my $columns;
4581
4582   local $SIG{HUP} = 'IGNORE';
4583   local $SIG{INT} = 'IGNORE';
4584   local $SIG{QUIT} = 'IGNORE';
4585   local $SIG{TERM} = 'IGNORE';
4586   local $SIG{TSTP} = 'IGNORE';
4587   local $SIG{PIPE} = 'IGNORE';
4588
4589   my $oldAutoCommit = $FS::UID::AutoCommit;
4590   local $FS::UID::AutoCommit = 0;
4591   my $dbh = dbh;
4592
4593   #while ( $columns = $csv->getline($fh) ) {
4594   my $line;
4595   while ( defined($line=<$fh>) ) {
4596
4597     $csv->parse($line) or do {
4598       $dbh->rollback if $oldAutoCommit;
4599       return "can't parse: ". $csv->error_input();
4600     };
4601
4602     my @columns = $csv->fields();
4603     #warn join('-',@columns);
4604
4605     my %row = ();
4606     foreach my $field ( @fields ) {
4607       $row{$field} = shift @columns;
4608     }
4609
4610     if ( $row{custnum} && $row{agent_custid} ) {
4611       dbh->rollback if $oldAutoCommit;
4612       return "can't specify custnum with agent_custid $row{agent_custid}";
4613     }
4614
4615     my %hash = ();
4616     if ( $row{agent_custid} && $agentnum ) {
4617       %hash = ( 'agent_custid' => $row{agent_custid},
4618                 'agentnum'     => $agentnum,
4619               );
4620     }
4621
4622     if ( $row{custnum} ) {
4623       %hash = ( 'custnum' => $row{custnum} );
4624     }
4625
4626     unless ( scalar(keys %hash) ) {
4627       $dbh->rollback if $oldAutoCommit;
4628       return "can't find customer without custnum or agent_custid and agentnum";
4629     }
4630
4631     my $cust_main = qsearchs('cust_main', { %hash } );
4632     unless ( $cust_main ) {
4633       $dbh->rollback if $oldAutoCommit;
4634       my $custnum = $row{custnum} || $row{agent_custid};
4635       return "unknown custnum $custnum";
4636     }
4637
4638     if ( $row{'amount'} > 0 ) {
4639       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4640       if ( $error ) {
4641         $dbh->rollback if $oldAutoCommit;
4642         return $error;
4643       }
4644       $imported++;
4645     } elsif ( $row{'amount'} < 0 ) {
4646       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4647                                       $row{'pkg'}                         );
4648       if ( $error ) {
4649         $dbh->rollback if $oldAutoCommit;
4650         return $error;
4651       }
4652       $imported++;
4653     } else {
4654       #hmm?
4655     }
4656
4657   }
4658
4659   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4660
4661   return "Empty file!" unless $imported;
4662
4663   ''; #no error
4664
4665 }
4666
4667 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4668
4669 Deprecated.  Use event notification and message templates
4670 (L<FS::msg_template>) instead.
4671
4672 Sends a templated email notification to the customer (see L<Text::Template>).
4673
4674 OPTIONS is a hash and may include
4675
4676 I<from> - the email sender (default is invoice_from)
4677
4678 I<to> - comma-separated scalar or arrayref of recipients
4679    (default is invoicing_list)
4680
4681 I<subject> - The subject line of the sent email notification
4682    (default is "Notice from company_name")
4683
4684 I<extra_fields> - a hashref of name/value pairs which will be substituted
4685    into the template
4686
4687 The following variables are vavailable in the template.
4688
4689 I<$first> - the customer first name
4690 I<$last> - the customer last name
4691 I<$company> - the customer company
4692 I<$payby> - a description of the method of payment for the customer
4693             # would be nice to use FS::payby::shortname
4694 I<$payinfo> - the account information used to collect for this customer
4695 I<$expdate> - the expiration of the customer payment in seconds from epoch
4696
4697 =cut
4698
4699 sub notify {
4700   my ($self, $template, %options) = @_;
4701
4702   return unless $conf->exists($template);
4703
4704   my $from = $conf->config('invoice_from', $self->agentnum)
4705     if $conf->exists('invoice_from', $self->agentnum);
4706   $from = $options{from} if exists($options{from});
4707
4708   my $to = join(',', $self->invoicing_list_emailonly);
4709   $to = $options{to} if exists($options{to});
4710
4711   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4712     if $conf->exists('company_name', $self->agentnum);
4713   $subject = $options{subject} if exists($options{subject});
4714
4715   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4716                                             SOURCE => [ map "$_\n",
4717                                               $conf->config($template)]
4718                                            )
4719     or die "can't create new Text::Template object: Text::Template::ERROR";
4720   $notify_template->compile()
4721     or die "can't compile template: Text::Template::ERROR";
4722
4723   $FS::notify_template::_template::company_name =
4724     $conf->config('company_name', $self->agentnum);
4725   $FS::notify_template::_template::company_address =
4726     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4727
4728   my $paydate = $self->paydate || '2037-12-31';
4729   $FS::notify_template::_template::first = $self->first;
4730   $FS::notify_template::_template::last = $self->last;
4731   $FS::notify_template::_template::company = $self->company;
4732   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4733   my $payby = $self->payby;
4734   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4735   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4736
4737   #credit cards expire at the end of the month/year of their exp date
4738   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4739     $FS::notify_template::_template::payby = 'credit card';
4740     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4741     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4742     $expire_time--;
4743   }elsif ($payby eq 'COMP') {
4744     $FS::notify_template::_template::payby = 'complimentary account';
4745   }else{
4746     $FS::notify_template::_template::payby = 'current method';
4747   }
4748   $FS::notify_template::_template::expdate = $expire_time;
4749
4750   for (keys %{$options{extra_fields}}){
4751     no strict "refs";
4752     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4753   }
4754
4755   send_email(from => $from,
4756              to => $to,
4757              subject => $subject,
4758              body => $notify_template->fill_in( PACKAGE =>
4759                                                 'FS::notify_template::_template'                                              ),
4760             );
4761
4762 }
4763
4764 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4765
4766 Generates a templated notification to the customer (see L<Text::Template>).
4767
4768 OPTIONS is a hash and may include
4769
4770 I<extra_fields> - a hashref of name/value pairs which will be substituted
4771    into the template.  These values may override values mentioned below
4772    and those from the customer record.
4773
4774 The following variables are available in the template instead of or in addition
4775 to the fields of the customer record.
4776
4777 I<$payby> - a description of the method of payment for the customer
4778             # would be nice to use FS::payby::shortname
4779 I<$payinfo> - the masked account information used to collect for this customer
4780 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4781 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4782
4783 =cut
4784
4785 # a lot like cust_bill::print_latex
4786 sub generate_letter {
4787   my ($self, $template, %options) = @_;
4788
4789   return unless $conf->exists($template);
4790
4791   my $letter_template = new Text::Template
4792                         ( TYPE       => 'ARRAY',
4793                           SOURCE     => [ map "$_\n", $conf->config($template)],
4794                           DELIMITERS => [ '[@--', '--@]' ],
4795                         )
4796     or die "can't create new Text::Template object: Text::Template::ERROR";
4797
4798   $letter_template->compile()
4799     or die "can't compile template: Text::Template::ERROR";
4800
4801   my %letter_data = map { $_ => $self->$_ } $self->fields;
4802   $letter_data{payinfo} = $self->mask_payinfo;
4803
4804   #my $paydate = $self->paydate || '2037-12-31';
4805   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4806
4807   my $payby = $self->payby;
4808   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4809   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4810
4811   #credit cards expire at the end of the month/year of their exp date
4812   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4813     $letter_data{payby} = 'credit card';
4814     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4815     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4816     $expire_time--;
4817   }elsif ($payby eq 'COMP') {
4818     $letter_data{payby} = 'complimentary account';
4819   }else{
4820     $letter_data{payby} = 'current method';
4821   }
4822   $letter_data{expdate} = $expire_time;
4823
4824   for (keys %{$options{extra_fields}}){
4825     $letter_data{$_} = $options{extra_fields}->{$_};
4826   }
4827
4828   unless(exists($letter_data{returnaddress})){
4829     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4830                                                   $self->agent_template)
4831                      );
4832     if ( length($retadd) ) {
4833       $letter_data{returnaddress} = $retadd;
4834     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4835       $letter_data{returnaddress} =
4836         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4837                           s/$/\\\\\*/;
4838                           $_;
4839                         }
4840                     ( $conf->config('company_name', $self->agentnum),
4841                       $conf->config('company_address', $self->agentnum),
4842                     )
4843         );
4844     } else {
4845       $letter_data{returnaddress} = '~';
4846     }
4847   }
4848
4849   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4850
4851   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4852
4853   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4854
4855   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4856                            DIR      => $dir,
4857                            SUFFIX   => '.eps',
4858                            UNLINK   => 0,
4859                          ) or die "can't open temp file: $!\n";
4860   print $lh $conf->config_binary('logo.eps', $self->agentnum)
4861     or die "can't write temp file: $!\n";
4862   close $lh;
4863   $letter_data{'logo_file'} = $lh->filename;
4864
4865   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4866                            DIR      => $dir,
4867                            SUFFIX   => '.tex',
4868                            UNLINK   => 0,
4869                          ) or die "can't open temp file: $!\n";
4870
4871   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4872   close $fh;
4873   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4874   return ($1, $letter_data{'logo_file'});
4875
4876 }
4877
4878 =item print_ps TEMPLATE
4879
4880 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4881
4882 =cut
4883
4884 sub print_ps {
4885   my $self = shift;
4886   my($file, $lfile) = $self->generate_letter(@_);
4887   my $ps = FS::Misc::generate_ps($file);
4888   unlink($file.'.tex');
4889   unlink($lfile);
4890
4891   $ps;
4892 }
4893
4894 =item print TEMPLATE
4895
4896 Prints the filled in template.
4897
4898 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4899
4900 =cut
4901
4902 sub queueable_print {
4903   my %opt = @_;
4904
4905   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
4906     or die "invalid customer number: " . $opt{custvnum};
4907
4908   my $error = $self->print( $opt{template} );
4909   die $error if $error;
4910 }
4911
4912 sub print {
4913   my ($self, $template) = (shift, shift);
4914   do_print [ $self->print_ps($template) ];
4915 }
4916
4917 #these three subs should just go away once agent stuff is all config overrides
4918
4919 sub agent_template {
4920   my $self = shift;
4921   $self->_agent_plandata('agent_templatename');
4922 }
4923
4924 sub agent_invoice_from {
4925   my $self = shift;
4926   $self->_agent_plandata('agent_invoice_from');
4927 }
4928
4929 sub _agent_plandata {
4930   my( $self, $option ) = @_;
4931
4932   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
4933   #agent-specific Conf
4934
4935   use FS::part_event::Condition;
4936
4937   my $agentnum = $self->agentnum;
4938
4939   my $regexp = regexp_sql();
4940
4941   my $part_event_option =
4942     qsearchs({
4943       'select'    => 'part_event_option.*',
4944       'table'     => 'part_event_option',
4945       'addl_from' => q{
4946         LEFT JOIN part_event USING ( eventpart )
4947         LEFT JOIN part_event_option AS peo_agentnum
4948           ON ( part_event.eventpart = peo_agentnum.eventpart
4949                AND peo_agentnum.optionname = 'agentnum'
4950                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
4951              )
4952         LEFT JOIN part_event_condition
4953           ON ( part_event.eventpart = part_event_condition.eventpart
4954                AND part_event_condition.conditionname = 'cust_bill_age'
4955              )
4956         LEFT JOIN part_event_condition_option
4957           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
4958                AND part_event_condition_option.optionname = 'age'
4959              )
4960       },
4961       #'hashref'   => { 'optionname' => $option },
4962       #'hashref'   => { 'part_event_option.optionname' => $option },
4963       'extra_sql' =>
4964         " WHERE part_event_option.optionname = ". dbh->quote($option).
4965         " AND action = 'cust_bill_send_agent' ".
4966         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
4967         " AND peo_agentnum.optionname = 'agentnum' ".
4968         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
4969         " ORDER BY
4970            CASE WHEN part_event_condition_option.optionname IS NULL
4971            THEN -1
4972            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
4973         " END
4974           , part_event.weight".
4975         " LIMIT 1"
4976     });
4977
4978   unless ( $part_event_option ) {
4979     return $self->agent->invoice_template || ''
4980       if $option eq 'agent_templatename';
4981     return '';
4982   }
4983
4984   $part_event_option->optionvalue;
4985
4986 }
4987
4988 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
4989
4990 Subroutine (not a method), designed to be called from the queue.
4991
4992 Takes a list of options and values.
4993
4994 Pulls up the customer record via the custnum option and calls bill_and_collect.
4995
4996 =cut
4997
4998 sub queued_bill {
4999   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5000
5001   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5002   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5003
5004   $cust_main->bill_and_collect( %args );
5005 }
5006
5007 sub process_bill_and_collect {
5008   my $job = shift;
5009   my $param = thaw(decode_base64(shift));
5010   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5011       or die "custnum '$param->{custnum}' not found!\n";
5012   $param->{'job'}   = $job;
5013   $param->{'fatal'} = 1; # runs from job queue, will be caught
5014   $param->{'retry'} = 1;
5015
5016   $cust_main->bill_and_collect( %$param );
5017 }
5018
5019 =item process_censustract_update CUSTNUM
5020
5021 Queueable function to update the census tract to the current year (as set in
5022 the 'census_year' configuration variable) and retrieve the new tract code.
5023
5024 =cut
5025
5026 sub process_censustract_update {
5027   eval "use FS::Misc::Geo qw(get_censustract)";
5028   die $@ if $@;
5029   my $custnum = shift;
5030   my $cust_main = qsearchs( 'cust_main', { custnum => $custnum })
5031       or die "custnum '$custnum' not found!\n";
5032
5033   my $new_year = $conf->config('census_year') or return;
5034   my $new_tract = get_censustract({ $cust_main->location_hash }, $new_year);
5035   if ( $new_tract =~ /^\d/ ) {
5036     # then it's a tract code
5037         $cust_main->set('censustract', $new_tract);
5038     $cust_main->set('censusyear',  $new_year);
5039
5040     local($ignore_expired_card) = 1;
5041     local($ignore_illegal_zip) = 1;
5042     local($ignore_banned_card) = 1;
5043     local($skip_fuzzyfiles) = 1;
5044     local($import) = 1; #prevent automatic geocoding (need its own variable?)
5045     my $error = $cust_main->replace;
5046     die $error if $error;
5047   }
5048   else {
5049     # it's an error message
5050     die $new_tract;
5051   }
5052   return;
5053 }
5054
5055 sub _upgrade_data { #class method
5056   my ($class, %opts) = @_;
5057
5058   my @statements = (
5059     'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5060     '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',
5061   );
5062   # fix yyyy-m-dd formatted paydates
5063   if ( driver_name =~ /^mysql/i ) {
5064     push @statements,
5065     "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5066   }
5067   else { # the SQL standard
5068     push @statements,
5069     "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5070   }
5071
5072   push @statements, #fix the weird BILL with a cc# in payinfo problem
5073     #DCRD to be safe
5074     "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5075
5076   foreach my $sql ( @statements ) {
5077     my $sth = dbh->prepare($sql) or die dbh->errstr;
5078     $sth->execute or die $sth->errstr;
5079   }
5080
5081   local($ignore_expired_card) = 1;
5082   local($ignore_illegal_zip) = 1;
5083   local($ignore_banned_card) = 1;
5084   local($skip_fuzzyfiles) = 1;
5085   local($import) = 1; #prevent automatic geocoding (need its own variable?)
5086   $class->_upgrade_otaker(%opts);
5087
5088 }
5089
5090 =back
5091
5092 =head1 BUGS
5093
5094 The delete method.
5095
5096 The delete method should possibly take an FS::cust_main object reference
5097 instead of a scalar customer number.
5098
5099 Bill and collect options should probably be passed as references instead of a
5100 list.
5101
5102 There should probably be a configuration file with a list of allowed credit
5103 card types.
5104
5105 No multiple currency support (probably a larger project than just this module).
5106
5107 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5108
5109 Birthdates rely on negative epoch values.
5110
5111 The payby for card/check batches is broken.  With mixed batching, bad
5112 things will happen.
5113
5114 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5115
5116 =head1 SEE ALSO
5117
5118 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5119 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5120 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5121
5122 =cut
5123
5124 1;
5125