FS/FS/cust_main.pm

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