FS/FS/cust_main.pm

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